Viết code lấy tên tất cả các file trong 1 folder.

hoangminhtien · 7/12/09

Em có 1 folder chứa rất nhiều file. Em muốn lập 1 file excel để lấy tất cả tên các file này. Các bác xem ví dụ trong file đính kèm. Bác nào biết giúp em với nhé! Cám ơn các bác!

sealand · 7/12/09

Bạn dùng thử đoạn code sau:

PHP:

Sub ShowFileList()
Sheet1.[E:E].ClearContents
folderspec = "C:\WINDOWS"
    Dim fs, f, f1, fc, i
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFolder(folderspec)
    Set fc = f.Files
    i = 1
    For Each f1 In fc
    Sheet1.Cells(i, 5) = f1.Name
        i = i + 1
    Next
End Sub

Hai Lúa Miền Tây · 7/12/09

hoangminhtien đã viết:
Em có 1 folder chứa rất nhiều file. Em muốn lập 1 file excel để lấy tất cả tên các file này. Các bác xem ví dụ trong file đính kèm. Bác nào biết giúp em với nhé! Cám ơn các bác!

Thêm 1 link cho bạn tham khảo nè.
http://www.giaiphapexcel.com/forum/showthread.php?t=22278

ndu96081631 · 7/12/09

hoangminhtien đã viết:
Em có 1 folder chứa rất nhiều file. Em muốn lập 1 file excel để lấy tất cả tên các file này. Các bác xem ví dụ trong file đính kèm. Bác nào biết giúp em với nhé! Cám ơn các bác!

Gữi bạn code này:

PHP:

Public Dic
Private Sub ListFilesInFolder(FolderName As String, InSub As Boolean)
  Dim FileItem, SubFolder, FileName As String
  On Error GoTo Thoat
  With CreateObject("Scripting.FileSystemObject")
    With .GetFolder(FolderName)
      For Each FileItem In .Files
        FileName = FolderName & "\" & FileItem.Name
        Dic.Add FolderName & "\" & FileItem.Name, FileLen(FileName)
      Next FileItem
      If InSub Then
        For Each SubFolder In .subFolders
          ListFilesInFolder SubFolder.Path, True
        Next SubFolder
      End If
    End With
  End With
Thoat:
End Sub

PHP:

Sub GetFileList()
  Dim i As Long
  Set Dic = Nothing
  Set Dic = CreateObject("Scripting.Dictionary")
  Range("A2:B60000").Clear
  With Application.FileDialog(4)
    .Show: .AllowMultiSelect = False
    ListFilesInFolder .SelectedItems(1), True
  End With
  With Range("A2").Resize(Dic.Count)
    .Value = WorksheetFunction.Transpose(Dic.Keys)
    .Offset(, 1) = WorksheetFunction.Transpose(Dic.Items)
    .Offset(, 1).NumberFormat = "#,##0 ""KB"""
  End With
  Columns("A:B").AutoFit
End Sub

Đúng ra có thể dùng Application.FileSearch sẽ đơn giản hơn nhưng phải viết dài dòng thế vì để bạn có thể dùng nó trên Excel 2007 (FileSearch không dùng được trên Excel 2007)
Lưu ý:
- Code này có thể lấy list file trong mọi Folder
- Nếu bạn chỉ muốn lấy file tại folder mà bạn chọn (không lấy file trong folder con) tại tại đoạn code thứ hai, hãy sửa:
ListFilesInFolder .SelectedItems(1), True
thành:
ListFilesInFolder .SelectedItems(1), False

man231186 · 28/6/12

Dear anh!
- Anh cho em hỏi em muốn list danh sách như file của anh gửi nhưng thêm điều kiện là những file nào có tên tương ứng với tên file trong cột tên file mới hiện ra. Như vậy có làm được không ạ? Em cám ơn anh!

Quang_Hải · 28/6/12

Không hiểu hết ý của bạn nên làm theo cách đơn giản này
anh NDU có cách lấy tên file rất cao siêu, nếu cần bạn search và tham khảo. Tạm thời xài cách cơ bản này nha. Copy file đính kèm và lưu vào thư mục bạn muốn kiểm tra. Code này hạn chế với tiếng việt có dấu.

PHP:

Sub tenfile()
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
Fname = Dir(ThisWorkbook.Path & "\*.*")
Do While Fname <> ""
    dic.Add Fname, ""
    Fname = Dir
Loop
keys = Application.Transpose(dic.keys)
ten_file = Range([a2], [a65536].End(3)).Value
For j = 1 To UBound(ten_file, 1)
    For i = 1 To UBound(keys)
        If ten_file(j, 1) = keys(i, 1) Then MsgBox "Da tim thay file " & ten_file(j, 1)
    Next
Next
[B2].Resize(i - 1, 1) = keys
End Sub

be_09 · 28/6/12

hoangminhtien đã viết:
Em có 1 folder chứa rất nhiều file. Em muốn lập 1 file excel để lấy tất cả tên các file này. Các bác xem ví dụ trong file đính kèm. Bác nào biết giúp em với nhé! Cám ơn các bác!

Bạn có thể tải File tự động tạo Link đến bất kỳ các File có chứa trong thư mục để mở nó. tải File theo Link sau:

http://www.danketoan.com/forum/exce...le-co-chua-trong-thu-muc-de-mo-no.181494.html

siwtom · 29/6/12

ndu96081631 đã viết:
Gữi bạn code này:

PHP:

Public Dic Private Sub ListFilesInFolder(FolderName As String, InSub As Boolean) Dim FileItem, SubFolder, FileName As String On Error GoTo Thoat With CreateObject("Scripting.FileSystemObject") With .GetFolder(FolderName) For Each FileItem In .Files FileName = FolderName & "\" & FileItem.Name Dic.Add FolderName & "\" & FileItem.Name, FileLen(FileName) Next FileItem If InSub Then For Each SubFolder In .subFolders ListFilesInFolder SubFolder.Path, True Next SubFolder End If End With End With Thoat: End Sub

PHP:

Sub GetFileList() Dim i As Long Set Dic = Nothing Set Dic = CreateObject("Scripting.Dictionary") Range("A2:B60000").Clear With Application.FileDialog(4) .Show: .AllowMultiSelect = False ListFilesInFolder .SelectedItems(1), True End With With Range("A2").Resize(Dic.Count) .Value = WorksheetFunction.Transpose(Dic.Keys) .Offset(, 1) = WorksheetFunction.Transpose(Dic.Items) .Offset(, 1).NumberFormat = "#,##0 ""KB""" End With Columns("A:B").AutoFit End Sub

Đúng ra có thể dùng Application.FileSearch sẽ đơn giản hơn nhưng phải viết dài dòng thế vì để bạn có thể dùng nó trên Excel 2007 (FileSearch không dùng được trên Excel 2007)
Lưu ý:
- Code này có thể lấy list file trong mọi Folder
- Nếu bạn chỉ muốn lấy file tại folder mà bạn chọn (không lấy file trong folder con) tại tại đoạn code thứ hai, hãy sửa:
ListFilesInFolder .SelectedItems(1), True
thành:
ListFilesInFolder .SelectedItems(1), False

Tôi nói rõ thêm để mọi người ý thức được và khỏi bị bất ngờ. Tôi thấy bạn quanghai1969 hướng dẫn rất hay. Bạn đó nói rõ ràng là code có những hạn chế gì. Như vậy nếu ai quyết định dùng thì sẽ ý thức được hạn chế đó và không bị bất ngờ.
Code của bạn nduđẹp rồi nhưng ...
Có chút gõ thiếu

Mã:

FileName = FolderName & "\" & FileItem.Name
Dic.Add FolderName & "" & FileItem.Name, FileLen(FileName)
Phải là
FileName = FolderName & "\" & FileItem.Name
Dic.Add FolderName & "[COLOR=#ff0000]\[/COLOR]" & FileItem.Name, FileLen(FileName)
Hoặc 
FileName = FolderName & "\" & FileItem.Name
Dic.Add FileName, FileLen(FileName)

Cái này không phải là lỗi, tôi sửa lại cho đúng ý bạn ndu mà thôi.

Nhưng thực ra code trên cũng không đúng. Nếu trong cửa sổ FileDialog ta chọn ổ C thì sau đó ta có các tập tin dạng "C:\\autoexec.bat"

Về code thì code không phục vụ tiếng Việt. Tức nếu chọn thư mục tiếng Việt thì sẽ không có file nào trả về (cả ở thư mục chính lẫn các thư mục con), còn nếu có thư mục con tiếng Việt thì sẽ mất tất cả các file ở thư mục đó và các thư mục con. Nếu tên các thư mục không là tiếng Việt thì cũng sẽ mất file tiếng Việt này, và tất cả các file sau (tiếng Việt hay không tiếng Việt - với On Error GoTo Thoat như hiện nay) hoặc tất cả các file tiếng Việt sau (với On Error Resume Next)
Bản thân tôi không dùng tên tập tin hay thư mục tiếng Việt nhưng nhiều khi điều đó không phụ thuộc vào chúng ta. Có những lúc ta lấy từ nguồn ngoài (vd. tải từ mạng về). Nếu ít tập tin thì cũng còn bỏ công ra để sửa lại tên nhưng nếu quá nhiều thì nhiều khi ta "phẩy tay"
Cũng nên lưu ý là không nên viết

PHP:

With Application.FileDialog(4)
    .Show: .AllowMultiSelect = False
    ListFilesInFolder .SelectedItems(1), True
End With

Không phải nút Cancel trong các cửa sổ trong Windows được thêm vào để làm vì. Vậy nếu người dùng chọn Cancel thì sẽ có lỗi. Thực ra lỗi kiểu này trong Excel không gây hậu quả tai hại. Có lỗi thì tôi sửa lại code rồi "chạy" lại. Nhưng nếu vẫn thói quen lập trình đó mà một tương lai không xa ta viết phần mềm EXE và bán cho khách mà có lỗi như thế thì khách muốn tự sửa cũng không sửa được.
Những cái "vụn vặt" này rất quan trọng trong lập trình. Nhiều khi những cái "vụn vặt" làm hỏng cả một chương trình đẹp.
Về chuyện tiếng Việt ở trên thì thủ phạm là hàm FileLen.

ndu96081631 · 29/6/12

siwtom đã viết:
Nhưng thực ra code trên cũng không đúng. Nếu trong cửa sổ FileDialog ta chọn ổ C thì sau đó ta có các tập tin dạng "C:\\autoexec.bat"

Về code thì code không phục vụ tiếng Việt. Tức nếu chọn thư mục tiếng Việt thì sẽ không có file nào trả về (cả ở thư mục chính lẫn các thư mục con), còn nếu có thư mục con tiếng Việt thì sẽ mất tất cả các file ở thư mục đó và các thư mục con. Nếu tên các thư mục không là tiếng Việt thì cũng sẽ mất file tiếng Việt này, và tất cả các file sau (tiếng Việt hay không tiếng Việt - với On Error GoTo Thoat như hiện nay) hoặc tất cả các file tiếng Việt sau (với On Error Resume Next)
Bản thân tôi không dùng tên tập tin hay thư mục tiếng Việt nhưng nhiều khi điều đó không phụ thuộc vào chúng ta. Có những lúc ta lấy từ nguồn ngoài (vd. tải từ mạng về). Nếu ít tập tin thì cũng còn bỏ công ra để sửa lại tên nhưng nếu quá nhiều thì nhiều khi ta "phẩy tay"
Cũng nên lưu ý là không nên viết

Code này tôi viết đã lâu (từ năm 2009), khi ấy chỉ mới tập tành VBA thôi nên có sơ suất 1 chút. Đã dùng Scripting.FileSystemObject mà lại đi xài hàm FileLen nên vẫn bị lỗi với tiếng Việt ---> Đúng ra vẫn có thể dùng Scripting.FileSystemObject để lấy file size
Tôi đã sửa lại code trên như sau:

PHP:

Public Dic As Object
Private Sub ListFilesInFolder(fldName As String, InSub As Boolean)
  Dim fleItem As Object, fldItem, fleName As String, fleSize As Double
  On Error Resume Next
  With CreateObject("Scripting.FileSystemObject")
    With .GetFolder(fldName)
      For Each fleItem In .Files
        fleName = fleItem.Path
        fleSize = fleItem.Size
        Dic.Add fleName, fleSize
      Next
      If InSub Then
        For Each fldItem In .SubFolders
          ListFilesInFolder fldItem.Path, True
        Next
      End If
    End With
  End With
End Sub

PHP:

Sub GetFileList()
  Dim tmpArr1, tmpArr2, Arr(), fldName As String, lCount As Long, n As Long
  Range("A2:B60000").Clear
  Set Dic = CreateObject("Scripting.Dictionary")
  On Error Resume Next
  With Application.FileDialog(4)
    .Show: .AllowMultiSelect = False
    fldName = .SelectedItems(1)
    If Len(fldName) Then ListFilesInFolder .SelectedItems(1), True
  End With
  On Error GoTo 0
  lCount = Dic.Count
  If lCount Then
    tmpArr1 = Dic.Keys
    tmpArr2 = Dic.Items
    ReDim Arr(1 To lCount, 1 To 2)
    For n = 1 To lCount
      Arr(n, 1) = tmpArr1(n - 1)
      Arr(n, 2) = tmpArr2(n - 1)
    Next
    With Range("A2").Resize(lCount, 2)
      .Value = Arr
      .Offset(, 1).Resize(, 1).NumberFormat = "#,##0 ""KB"""
    End With
    Columns("A:B").AutoFit
  End If
End Sub

Tuy nhiên nếu code này chạy trên Windows 7 thì vẫn còn 1 rắc rối với UAC ---> Windows sẽ không cho phép bất kỳ truy cập trái phép nào đối với folder hệ thống... khi ấy ta còn phải làm thêm rất nhiều công đoạn nữa mới mong code chạy ngon lành
-----------------------------------
Nếu có thời gian, bạn vui lòng góp ý cho tôi thêm về vấn đề này nhé
Cảm ơn

ndu96081631 · 29/6/12

man231186 đã viết:
Dear anh!
- Anh cho em hỏi em muốn list danh sách như file của anh gửi nhưng thêm điều kiện là những file nào có tên tương ứng với tên file trong cột tên file mới hiện ra. Như vậy có làm được không ạ? Em cám ơn anh!

Trường hợp của bạn, có thể sửa sub thứ 2 thành vầy:

PHP:

Sub GetFileList()
  Dim tmpArr, Arr(), fldName As String, lCount As Long, n As Long
  Dim libItem, libArr, tmp
  Range("A2:B60000").Clear
  Set Dic = CreateObject("Scripting.Dictionary")
  On Error Resume Next
  With Application.FileDialog(4)
    .Show: .AllowMultiSelect = False
    fldName = .SelectedItems(1)
    If Len(fldName) Then ListFilesInFolder .SelectedItems(1), True
  End With
  On Error GoTo 0
  lCount = Dic.Count
  If lCount Then
    tmpArr = Dic.Keys
    ReDim Arr(1 To lCount, 1 To 2)
    libArr = Range("C2:C7").Value
    For Each libItem In libArr
      If Len(CStr(libItem)) Then
        tmp = Filter(tmpArr, libItem & ".xls", True, vbTextCompare)
        If UBound(tmp) > -1 Then
          n = n + 1
          Arr(n, 1) = tmp(0)
          Arr(n, 2) = Dic.Item(tmp(0))
        End If
      End If
    Next
    If n Then
      With Range("A2").Resize(n, 2)
        .Value = Arr
        .Offset(, 1).Resize(, 1).NumberFormat = "#,##0 ""KB"""
      End With
      Columns("A:B").AutoFit
    End If
  End If
End Sub

Sub thứ nhất lấy tại bài 9 nha

ThuNghi · 29/6/12

Lâu quá trở lại vấn đề này. Nhờ NDU viết code mà khi nhấn thì browse và chỉ liệt kê những file xls cho mình chọn. Ưu tiên cho folder đang chứa file hiện hành. Trên GPE NDU có viết cho mình rồi mà tìm chưa thấy.
Cám ơn!

ndu96081631 · 29/6/12

ThuNghi đã viết:
Lâu quá trở lại vấn đề này. Nhờ NDU viết code mà khi nhấn thì browse và chỉ liệt kê những file xls cho mình chọn. Ưu tiên cho folder đang chứa file hiện hành. Trên GPE NDU có viết cho mình rồi mà tìm chưa thấy.
Cám ơn!

Chắc là dạng này chăng:

PHP:

With Application.FileDialog(msoFileDialogFilePicker)
 .Filters.Clear
 .Filters.Add "Excel File", "*.xls"
 .InitialFileName = ThisWorkbook.FullName
 .Show
  MsgBox .SelectedItems(1)
End With

Nhưng đó là Dialog để duyệt file nha

ThuNghi · 29/6/12

ndu96081631 đã viết:
Chắc là dạng này chăng:

PHP:

With Application.FileDialog(msoFileDialogFilePicker) .Filters.Clear .Filters.Add "Excel File", "*.xls" .InitialFileName = ThisWorkbook.FullName .Show MsgBox .SelectedItems(1) End With

Nhưng đó là Dialog để duyệt file nha

Cũng dạng vậy.
Yêu cầu là thế này:
- Muốn lấy dữ liệu từ 1 file abc.xls
- Thay vì chép file abc trên vào chung 1 folder, open và lấy dữ liệu thì mình dùng hộp thoại để mở folder (ưu tiên hiện hành) và cho phép chọn file *.xls.
Nhớ là code này có lâu rồi mà tìm chưa ra.
Cám ơn.

ndu96081631 · 29/6/12

ThuNghi đã viết:
Cũng dạng vậy.
Yêu cầu là thế này:
- Muốn lấy dữ liệu từ 1 file abc.xls
- Thay vì chép file abc trên vào chung 1 folder, open và lấy dữ liệu thì mình dùng hộp thoại để mở folder (ưu tiên hiện hành) và cho phép chọn file *.xls.
Nhớ là code này có lâu rồi mà tìm chưa ra.
Cám ơn.

Cho phép chọn *.xls nghĩa là chọn nhiều file cùng lúc chăng?
Nếu là vậy thì chỉ cần thêm đoạn .AllowMultiSelect = True trước thằng .Show là được rồi

ThuNghi · 29/6/12

ndu96081631 đã viết:
Cho phép chọn *.xls nghĩa là chọn nhiều file cùng lúc chăng?
Nếu là vậy thì chỉ cần thêm đoạn .AllowMultiSelect = True trước thằng .Show là được rồi

Không phải, mở hộp thoại ra và chỉ hiển thị những file .xls trong folder để mình chọn 1 file abc và lấy dữ liệu.
Dạng như thế này, mở folder lên để chọn wbName.
Nhớ code trên là phải khai báo wbName.

PHP:

Sub TaoArrData()
myPath = ThisWorkbook.Path
If bWorkbookIsOpen(wbName) Then
  Windows(wbName).Activate
Else
  Workbooks.Open Filename:=myPath & "\" & wbName
End If
Set TgtWb = ActiveWorkbook
...

Cám ơn NDU, đã tìm ra rồi. NDU viết nhiều file quá nên tìm khó.

PHP:

Set SourceWb = ThisWorkbook
myPath = ThisWorkbook.Path
'mo file
With Application.FileDialog(msoFileDialogOpen)
  .InitialFileName = myPath
  .AllowMultiSelect = False
  .Filters.Clear
  .Filters.Add "Excel files", "*.xls" & "*"
  .Show
  If .SelectedItems.Count = 0 Then
      MsgBox "Ban chua chon file"
      Exit Sub
  End If
  Fname = .SelectedItems(1)
End With
'**** Lay du lieu
Workbooks.Open Filename:=Fname
Set TgtWb = ActiveWorkbook

man231186 · 29/6/12

ndu96081631 đã viết:

Trường hợp của bạn, có thể sửa sub thứ 2 thành vầy:

PHP:

Sub GetFileList()
  Dim tmpArr, Arr(), fldName As String, lCount As Long, n As Long
  Dim libItem, libArr, tmp
  Range("A2:B60000").Clear
  Set Dic = CreateObject("Scripting.Dictionary")
  On Error Resume Next
  With Application.FileDialog(4)
    .Show: .AllowMultiSelect = False
    fldName = .SelectedItems(1)
    If Len(fldName) Then ListFilesInFolder .SelectedItems(1), True
  End With
  On Error GoTo 0
  lCount = Dic.Count
  If lCount Then
    tmpArr = Dic.Keys
    ReDim Arr(1 To lCount, 1 To 2)
    libArr = Range("C2:C7").Value
    For Each libItem In libArr
      If Len(CStr(libItem)) Then
        tmp = Filter(tmpArr, libItem & ".xls", True, vbTextCompare)
        If UBound(tmp) > -1 Then
          n = n + 1
          Arr(n, 1) = tmp(0)
          Arr(n, 2) = Dic.Item(tmp(0))
        End If
      End If
    Next
    If n Then
      With Range("A2").Resize(n, 2)
        .Value = Arr
        .Offset(, 1).Resize(, 1).NumberFormat = "#,##0 ""KB"""
      End With
      Columns("A:B").AutoFit
    End If
  End If
End Sub

Sub thứ nhất lấy tại bài 9 nha

Anh ơi, nếu thế này khi có 1 tỉnh không có trong file mà nằm trước tỉnh có thì không lọc đúng. Như vậy anh ạ

ndu96081631 · 29/6/12

man231186 đã viết:
Anh ơi, nếu thế này khi có 1 tỉnh không có trong file mà nằm trước tỉnh có thì không lọc đúng. Như vậy anh ạ

Ah... rắc rối nhỉ
Vậy sửa lại thế này nhé:

PHP:

Sub GetFileList()
  Dim tmpArr, Arr(), fldName As String, lCount As Long, n As Long
  Dim libItem, libArr, tmp
  Range("A2:B60000").Clear
  Set Dic = CreateObject("Scripting.Dictionary")
  On Error Resume Next
  With Application.FileDialog(4)
    .Show: .AllowMultiSelect = False
    fldName = .SelectedItems(1)
    If Len(fldName) Then ListFilesInFolder .SelectedItems(1), True
  End With
  On Error GoTo 0
  lCount = Dic.Count
  If lCount Then
    tmpArr = Dic.Keys
    ReDim Arr(1 To lCount, 1 To 2)
    libArr = Range("C2:C7").Value
    For n = 1 To UBound(libArr)
      libItem = libArr(n, 1)
      If Len(CStr(libItem)) Then
        tmp = Filter(tmpArr, libItem & ".xls", True, vbTextCompare)
        If UBound(tmp) > -1 Then
          Arr(n, 1) = tmp(0)
          Arr(n, 2) = Dic.Item(tmp(0))
        End If
      End If
    Next
    If n Then
      With Range("A2").Resize(lCount, 2)
        .Value = Arr
        .Offset(, 1).Resize(, 1).NumberFormat = "#,##0 ""KB"""
      End With
      Columns("A:B").AutoFit
    End If
  End If
End Sub

Hy vọng đúng ý bạn

man231186 · 30/6/12

Anh ơi, có 1 vấn đề nữa là mở rộng các tên để lọc file thì không chạy được ạ. Có xử lý được không ạ?

be_09 · 30/6/12

man231186 đã viết:
Anh ơi, có 1 vấn đề nữa là mở rộng các tên để lọc file thì không chạy được ạ. Có xử lý được không ạ?

Bạn đọc và tải File tại bài này.
Phầm mềm chuyển các file trong folder sang excel để dễ dàng quản lý. Đây là Link:
http://www.giaiphapexcel.com/forum/...le-trong-folder-sang-excel-để-dễ-dàng-quản-lý

man231186 · 1/7/12

À mình không có mục đích quản lý văn bản bạn ạ. Mình đang thực hiện theo cách của anh ndu hướng dẫn nên đang nhờ anh ý code giúp phần bị vần đề. Thank bạn!

Viết code lấy tên tất cả các file trong 1 folder.

Thành viên gắn bó

File đính kèm

Thành viên gạo cội

File đính kèm

❆❆❆❆❆❆❆❆

Huyền thoại GPE

File đính kèm

Thành viên mới

File đính kèm

Thành viên gạo cội

File đính kèm

Biên Hòa, Đồng Nai

Thành viên gắn bó

Huyền thoại GPE

Huyền thoại GPE

File đính kèm

Hãy cho rồi sẽ nhận!

Huyền thoại GPE

Hãy cho rồi sẽ nhận!

Huyền thoại GPE

Hãy cho rồi sẽ nhận!

Thành viên mới

File đính kèm

Huyền thoại GPE

Thành viên mới

File đính kèm

Biên Hòa, Đồng Nai

Thành viên mới

Facebook

Group