Arrays 子循环时保留数组值
我目前有这段代码,可以查找所有文件和文件夹并将其写入表中。问题是它有时很慢 下面的代码经过修改,可以写入数组,但是当代码循环时,我在传递数组时遇到了问题 最后,我希望将数组传递给第一个子数组,以便我可以立即将其转置到表中Arrays 子循环时保留数组值,arrays,excel,vba,multidimensional-array,Arrays,Excel,Vba,Multidimensional Array,我目前有这段代码,可以查找所有文件和文件夹并将其写入表中。问题是它有时很慢 下面的代码经过修改,可以写入数组,但是当代码循环时,我在传递数组时遇到了问题 最后,我希望将数组传递给第一个子数组,以便我可以立即将其转置到表中 Sub FileAndFolder() Dim FSOLibrary As Object Dim FSOFolder As Object Dim FolderName As String Dim FilesTbl As ListObject Set FilesTbl = Ra
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
谢谢。您需要在模块级别声明一个变量,以便模块中的所有方法都可以使用文件夹信息列表,或者将“LoopAllFolders”更改为函数,以便可以返回已整理的信息 下面的函数将返回一个包含数组数组(通常称为锯齿数组)的变量。您可以使用此命名法访问锯齿状数组
Varname(x)(y)
在调用方法中需要一个变量来接收交错数组
e、 g
下面是更新后的函数
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插件。创建文件夹所有子文件夹的文件列表
- 我不明白你在用
做什么,所以我修改了你的解决方案,用结果创建了一个新的工作簿。当然,您将了解如何将其应用到表中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
太棒了,谢谢。我对它做了一些调整,现在已经将我的原始代码减半了
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