Sub 循环时保留数组值

Question

我目前有这段代码可以查找所有文件和文件夹并将其写入表中。问题是有时会很慢。

下面的代码经过修改，以便写入数组，但在代码循环时传递数组时遇到问题。

最终，我希望数组传递给第一个子，以便我可以立即将其转置到表中。

Sub FileAndFolder()

Dim FSOLibrary As Object
Dim FSOFolder As Object
Dim FolderName As String
Dim FilesTbl As ListObject
Set FilesTbl = Range("FilesTbl").ListObject

'Set the folder name to a variable
FolderName = Left$(ActiveWorkbook.Path, InStrRev(ActiveWorkbook.Path, "\"))

'Set the reference to the FSO Library
Set FSOLibrary = CreateObject("Scripting.FileSystemObject")

'Another Macro must call LoopAllSubFolders Macro to start
LoopAllFolders FSOLibrary.GetFolder(FolderName)

'return TempArray here and paste into table

'Range(FilesTbl.ListColumns("File Name").DataBodyRange(1)) = TempArray

End Sub

Sub LoopAllFolders(FSOFolder As Object)
'Don’t run the following macro, it will be called from the macro above

Dim FSOSubFolder As Object
Dim FSOFile As Object
Dim FolderPath As String
Dim FileName As String
Dim TempArray() As String

'For each subfolder call the macro
For Each FSOSubFolder In FSOFolder.SubFolders
    LoopAllFolders FSOSubFolder
Next

'For each file, print the name
For Each FSOFile In FSOFolder.Files

    'Insert the actions to be performed on each file
    FileName = FSOFile.Name
    FolderPath = FSOFile.ParentFolder
          
    If Left(FileName, 2) = "~$" Then GoTo NEXTINLOOP
    ReDim Preserve TempArray(0 To 3, 0 To i)
        
    TempArray(0, i) = FileName
    TempArray(1, i) = FolderPath & "\" & FileName 'file
    TempArray(2, i) = FolderPath 'folder
    TempArray(3, i) = FolderPath & "\" & FileName 'showpath
        
    i = i + 1
NEXTINLOOP:
Next
 
End Sub 'TempArray and i clears here

谢谢。

Answer 1

您需要在模块级别声明一个变量，以便模块中的所有方法都可以使用文件夹信息列表，或者将“LoopAllFolders”更改为函数，以便您可以返回已整理的信息。

下面的函数将返回一个包含数组的数组（通常称为交错数组）的 Variant。您可以使用此命名法访问锯齿状数组

Varname(x)(y)

您将需要在调用方法中使用一个变量来接收锯齿状数组

例如

Dim myFileInfo as Variant
MyFileInfo = LoopAllFolders(FSOLibrary.GetFolder(FolderName))

这是更新的功能

Public Function LoopAllFolders(FSOFolder As Scripting.FileSystemObject) As Variant
'Don’t run the following macro, it will be called from the macro above

    Dim FileInfo As Scripting.Dictionary: Set myFileInfo = New Scripting.Dictionary

'For each subfolder call the macro

    Dim FSOSubFolder As Scripting.Folder
    For Each FSOSubFolder In FSOFolder.SubFolders
        LoopAllFolders FSOSubFolder
    Next

    'For each file, print the name
    Dim FSOFile As Scripting.File
    For Each FSOFile In FSOFolder.Files

        'Insert the actions to be performed on each file
        Dim FileName As String
        FileName = FSOFile.Name
    
        Dim FolderPath As String
        FolderPath = FSOFile.ParentFolder
          
        If Not Left(FileName, 2) = "~$" Then
    
            myFileInfo.Add Array(FileName, FolderPath & "\" & FileName, FolderPath, FolderPath & "\" & FileName)
        
        End If
    
    Next

    LoopAllFolders = myFileInfo.Items
 
End Function

上面的代码可能并不完美，但至少它为您指明了正确的方向。

根据您的问题，通过 VBA 教程您可能会做得很好，因为函数是相当基础的，如果您不知道它们......

为了在您的旅程中为您提供帮助，我还建议您安装出色且免费的 RubberDuck 插件。

Answer 2

创建文件夹的所有子文件夹的文件列表

• 我不明白你在用

  FilesTbl

  做什么，所以我修改了你的解决方案以使用结果创建一个新的工作簿。您肯定会弄清楚如何将其应用到桌子上。

快速修复

Option Explicit

Sub FileAndFolder()

    Dim FSOLibrary As Object
    Dim FSOFolder As Object
    Dim FolderName As String
    Dim FilesTbl As ListObject
    'Set FilesTbl = Range("FilesTbl").ListObject
    
    'Set the folder name to a variable
    FolderName = Left$(ActiveWorkbook.Path, InStrRev(ActiveWorkbook.Path, "\"))
    
    'Set the reference to the FSO Library
    Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
    
    Dim TempArray() As Variant ' ByRef
    
    'Another Macro must call LoopAllSubFolders Macro to start
    LoopAllFolders FSOLibrary.GetFolder(FolderName), TempArray
    
    'return TempArray here and paste into table
    With Workbooks.Add
        With ActiveSheet.Range("A1").Resize(UBound(TempArray, 2), UBound(TempArray))
            .Value = Application.Transpose(TempArray)
        End With
        .Saved = True
    End With
    
    'Range(FilesTbl.ListColumns("File Name").DataBodyRange(1)) = TempArray

End Sub

Sub LoopAllFolders(FSOFolder As Object, ByRef TempArray As Variant)
'Don’t run the following macro, it will be called from the macro above

    Dim FSOSubFolder As Object
    Dim FSOFile As Object
    Dim FolderPath As String
    Dim FileName As String
    Dim i As Long
    'Dim TempArray() As String
    
    'For each subfolder call the macro
    For Each FSOSubFolder In FSOFolder.SubFolders
        LoopAllFolders FSOSubFolder, TempArray
    Next
    
    'For each file, print the name
    For Each FSOFile In FSOFolder.Files
    
        'Insert the actions to be performed on each file
        FileName = FSOFile.Name
        FolderPath = FSOFile.ParentFolder
              
        If Left(FileName, 2) = "~$" Then GoTo NEXTINLOOP
        i = i + 1
        ReDim Preserve TempArray(1 To 4, 1 To i)
            
        TempArray(1, i) = FileName
        TempArray(2, i) = FolderPath & "\" & FileName 'file
        TempArray(3, i) = FolderPath 'folder
        TempArray(4, i) = FolderPath & "\" & FileName 'showpath
            
NEXTINLOOP:
    Next
 
End Sub 'TempArray and i clears here