[hỏi]lấy tên file (1 người xem)

[hoangminhgiam]

mình muốn macro lấy tên tất cả các file excel trong cùng thư mục với file chứa macro.
làm ơn giúp dùm.

 

[hungpecc1]

mình muốn macro lấy tên tất cả các file excel trong cùng thư mục với file chứa macro.
làm ơn giúp dùm.

Với excel 2003 có thể dùng Appliaction.Filesearch
Còn 2007, thì bạn có thể dùng FSO ( Lấy toàn bộ file trong folder cũng như folder con ):
ví dụ như code dưới đây của a Ndu...

[GPECODE=vb]
Sub ListFilesInFolder(FolderName As String,Insub as Boolean)
Dim FileItem As Scripting.File, SubFolder As Scripting.Folder
On Error GoTo Out
With New Scripting.FileSystemObject
With .GetFolder(FolderName)
For Each FileItem In .Files
MsgBox (FileItem.Name)
Next FileItem
If InSub Then
For Each SubFolder In .subFolders
ListFilesInFolder SubFolder.Path,true
Next SubFolder
End If
End With
End With
Out:
End Sub

Sub Main()
ListFilesInFolder ThisWorkbook.Path,true
End Sub
[/GPECODE]

Nếu muốn lấy nguyên file excel thì thêm câu lệnh này vào nữa là ok:

[GPECODE=vb]
If .GetExtensionName(FileItem.Path) = "xls"
[/GPECODE]

 

[nhapmon]

mình muốn macro lấy tên tất cả các file excel trong cùng thư mục với file chứa macro.
làm ơn giúp dùm.

bạn test lại xem đúng ko, mình test trên máy mình thì thấy chạy được (ex 2010)

Sub DS_File()


Dim TenFile As String
Dim j As Integer
TenFile = Dir(ThisWorkbook.Path & "\*.xls")
Do While TenFile <> ""
j = j + 1
Cells(j, 1).Value = TenFile
TenFile = Dir
Loop
End Sub

 

[ndu96081631]

Với excel 2003 có thể dùng Appliaction.Filesearch
Còn 2007, thì bạn có thể dùng FSO ( Lấy toàn bộ file trong folder cũng như folder con ):
ví dụ như code dưới đây của a Ndu...

[GPECODE=vb]
Sub ListFilesInFolder(FolderName As String,Insub as Boolean)
Dim FileItem As Scripting.File, SubFolder As Scripting.Folder
On Error GoTo Out
With New Scripting.FileSystemObject
With .GetFolder(FolderName)
For Each FileItem In .Files
MsgBox (FileItem.Name)
Next FileItem
If InSub Then
For Each SubFolder In .subFolders
ListFilesInFolder SubFolder.Path,true
Next SubFolder
End If
End With
End With
Out:
End Sub

Sub Main()
ListFilesInFolder ThisWorkbook.Path,true
End Sub
[/GPECODE]

Nếu muốn lấy nguyên file excel thì thêm câu lệnh này vào nữa là ok:

[GPECODE=vb]
If .GetExtensionName(FileItem.Path) = "xls"
[/GPECODE]

Ngày trước tôi dùng Scripting.FileSystemObject để lây tên file, folder, còn bây giờ tôi không dùng cái này nữa mà dùng lệnh DOS nhúng vào VBA ---> Tốc độ sẽ nhanh hơn

Function GetFilesList(ByVal Folder As String, ByVal Search As String, ByVal InSub As Boolean)
  Dim sComm As String, tmp As String, tmpFile, Arr
  On Error Resume Next
  If Right(Folder, 1) <> "\" Then Folder = Folder & "\"
  Search = """" & Folder & Search & """"
  With CreateObject("Scripting.FileSystemObject")
    tmpFile = .GetTempName
    sComm = "DIR " & Search & " /ON /B /A-D " & IIf(InSub, "/S", " ") & " >" & tmpFile
    CreateObject("Wscript.Shell").Run "cmd /u /c " & sComm, 0, True
    With .OpenTextFile(tmpFile, 1, , -2)
      tmp = Trim(.ReadAll)
      If Right(tmp, 2) = vbCrLf Then tmp = Left(tmp, Len(tmp) - 2)
      If Len(tmp) Then GetFilesList = Split(tmp, vbCrLf)
      .Close
    End With
  End With
  Kill tmpFile
End Function

Giờ, nếu muốn lấy list file xls trong cùng thư mục với file chứa code thì viết thế này:

Sub Main()
  Dim arr
  Arr = GetFilesList(ThisWorkbook.Path, "*.xls", True)
  If IsArray(arr) Then
    '[B]arr[/B] là 1 array chứa đường dẫn các file xls ---> Muốn làm gì tiếp, cứ viết code tại đây
  End If
End Sub

----------------------------

bạn test lại xem đúng ko, mình test trên máy mình thì thấy chạy được (ex 2010)

Sub DS_File()


Dim TenFile As String
Dim j As Integer
TenFile = Dir(ThisWorkbook.Path & "\*.xls")
Do While TenFile <> ""
j = j + 1
Cells(j, 1).Value = TenFile
TenFile = Dir
Loop
End Sub

Làm việc với file, folder, tốt nhất hãy quên đi mấy hàm có sẵn của VBA (như hàm Dir)... vì nó chẳng hổ trợ Unicode text trong tên file
Bạn có 2 lựa chọn: Hoặc là dùng Scripting.FileSystemObject, hoặc là dùng hàm tôi vừa viết ở trên