使用VBA获取excel文件名信息

Question

我有一个Main Folder，里面有多个sub-folder。 例如：主文件夹名称为MAIN。 在MAIN中，有sub-folder称为sub1，sub2，sub3，sub4 ..... 在sub-folder，它有很多优秀（太多，不知道准确的数字） 我使用VBA在MAIN中获取文件名。

这是我的第一次尝试：

Sub Get_MAIN_File_Names()
Dim xRow As Long
Dim xDirect, xFname

With Application.FileDialog(msoFileDialogFolderPicker)
   .Title = "Select Main File"
   .Show

   'LOCATES FILES
   If .SelectedItems.Count <> 0 Then
      xDirect = .SelectedItems(1) & "\"
      xFname = Dir(xDirect)

      'LOOPS THROUGH EACH FILE NAME IN FOLDER
      Do While xFname <> ""

        'EXTRACT INFORMATION FROM FILE NAME
         DrawingNumb = xFname
         RevNumb = xFname

        'INSERT INFO INTO EXCEL
         ActiveCell.Offset(xRow, 0) = DrawingNumb
         ActiveCell.Offset(xRow, 1) = RevNumb
         xFname = Dir()
         xRow = xRow + 1
      Loop

   End If
End With
End Sub

但是，我的VBA代码不正确。 对于此代码，我需要选择sub-folder来获取excels名称。 如何选择Main Folder并获取所有excels名称呢？ 而且，我也希望得到excels的修改时间。 有什么建议吗？

Answer 1

您需要在VBA编辑器中的Tools-> Reference下添加Microsoft Scripting Runtime。

FileSystemObject是你的朋友。请尝试对上面的代码进行以下更改：

Option Explicit

Private xRow As Long

Sub Get_MAIN_File_Names()
    Dim fso As FileSystemObject
    Dim xDirect As String
    Dim xRootFolder As Folder
    Dim DrawingNumb As String
    Dim RevNumb As String
    Dim rootFolderStr As String

    Set fso = New FileSystemObject
    xRow = 0
    With Application.FileDialog(msoFileDialogFolderPicker)
       .Title = "Select Main File"
       .Show

       'PROCESS ROOT FOLDER
       If .SelectedItems.Count <> 0 Then
          xDirect = .SelectedItems(1) & "\"
          Set xRootFolder = fso.GetFolder(xDirect)
          ProcessFolder fso, xRootFolder
       End If

    End With

End Sub

Private Sub ProcessFolder(fso As FileSystemObject, xFolder As Folder)
    Dim xFiles As files
    Dim xFile As File
    Dim xSubFolders As Folders
    Dim xSubFolder As Folder
    Dim DrawingNumb As String
    Dim RevNumb As String

    Set xFiles = xFolder.files

    'LOOPS THROUGH EACH FILE NAME IN FOLDER
    For Each xFile In xFiles

      'EXTRACT INFORMATION FROM FILE NAME
       DrawingNumb = xFile.Name
       RevNumb = xFile.Name

      'INSERT INFO INTO EXCEL
       ActiveCell.Offset(xRow, 0) = DrawingNumb
       ActiveCell.Offset(xRow, 1) = RevNumb
       xRow = xRow + 1
    Next xFile

    Set xSubFolders = xFolder.SubFolders
    For Each xSubFolder In xSubFolders
        ProcessFolder fso, xSubFolder
    Next xSubFolder

End Sub

Answer 2

要使代码生效，请设置对以下库的引用：Tools -> References -> Microsoft Scripting Runtime。

Private r As Long

Sub IterateOverFiles()
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    Call ProcessFolder(fso.GetFolder("C:\Main\"))
End Sub

Sub ProcessFolder(fld As Folder)
    Dim fl As File
    Dim subFld As Folder
    For Each fl In fld.Files
        r = r + 1
        Cells(r, "A") = fl.Name 'File name
        Cells(r, "B") = fl.Size 'File size
    Next
    For Each subFld In fld.SubFolders
        Call ProcessFolder(subFld)
    Next
End Sub