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

要使代码生效，请设置对以下库的引用：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

Answer 2

您需要在VBA编辑器中的Tools-＆gt; 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

使用VBA获取excel文件名信息

2 个答案: