我想访问当前文件夹的每个子文件夹(每个子文件夹中的子文件夹数量可能不同),然后想要在所有这些子文件夹的每个excel工作簿中执行一些操作。
下面提到的是代码和代码不会引发编译时错误但不起作用。请帮助我
option explicit
Sub LoopFolders()
Dim strFolder As String
Dim strSubFolder As String
Dim strFile As String
Dim colSubFolders As New Collection
Dim varItem As Variant
Dim wbk As Workbook
' Parent folder including trailing backslash
strFolder = "C:\Users\Yashika Vaish\Desktop\yashika\"
' Loop through the subfolders and fill Collection object
strSubFolder = Dir(strFolder & "*", vbDirectory)
Do While Not strSubFolder = ""
Select Case strSubFolder
Case ".", ".."
' Current folder or parent folder - ignore
Case Else
' Add to collection
colSubFolders.Add Item:=strSubFolder, Key:=strSubFolder
End Select
' On to the next one
strSubFolder = Dir
Loop
' Loop through the collection
For Each varItem In colSubFolders
' Loop through Excel workbooks in subfolder
strFile = Dir(strFolder & varItem & "\*.xls*")
Do While strFile <> ""
' Open workbook
Set wbk = Workbooks.Open(FileName:=strFolder & _
varItem & "\" & strFile, AddToMRU:=False)
MsgBox "I am open"
strFile = Dir
Loop
Next varItem
End Sub
此VBA项目中已添加工具设置中的所有必需参考。请帮助我使用此代码。
答案 0 :(得分:2)
下面的方法也会将子文件夹中的文件名写入工作簿。所以它找到了它们。
Sub Program()
Dim i As Integer
i = 1
listFiles "D:\Folder 1", i
End Sub
Sub listFiles(ByVal sPath As String, ByRef i As Integer)
Dim vaArray As Variant
Dim oFile As Object
Dim oFSO As Object
Dim oFolder As Object
Dim oFiles As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
Set oFiles = oFolder.Files
If (oFiles.Count > 0) Then
ReDim vaArray(1 To oFiles.Count)
For Each oFile In oFiles
Cells(i, "A").Value = oFile.Name
Cells(i, "B").Value = oFile.Path
i = i + 1
Next
End If
listFolders sPath, i
End Sub
Sub listFolders(ByVal sPath As String, ByRef i As Integer)
Dim vaArray As Variant
Dim oFile As Object
Dim oFSO As Object
Dim oFolder As Object
Dim oFiles As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(sPath)
Set oFiles = oFolder.subfolders
If (oFiles.Count > 0) Then
ReDim vaArray(1 To oFiles.Count)
For Each oFile In oFiles
listFiles oFile.Path, i
i = i + 1
Next
End If
End Sub
答案 1 :(得分:1)
这就是我使用的&amp;它是#WorksAtMyBox认证的代码;)
Option Explicit
Dim fso As Scripting.FileSystemObject
Dim fsoMainDirectory As Scripting.folder
Dim fsoSubfolder As Scripting.folder
Dim fsoFile As Scripting.file
Dim strFilePath
Dim filecounter As Long
Dim foldercounter As Long
Public Sub FileFinder(fileorfolder As String)
If fso Is Nothing Then
Set fso = New Scripting.FileSystemObject
End If
Set fsoMainDirectory = fso.GetFolder(fileorfolder)
If fsoMainDirectory.SubFolders.Count > 0 Then
For Each fsoSubfolder In fsoMainDirectory.SubFolders
foldercounter = foldercounter + 1
Debug.Print "Folder: " & foldercounter & fsoSubfolder.Path
FileFinder (fsoSubfolder.Path)
Next fsoSubfolder
End If
If fsoMainDirectory.Files.Count > 0 Then
For Each fsoFile In fsoMainDirectory.Files
ProcessFile (fsoFile.Path)
Next fsoFile
End If
End Sub
Public Sub ProcessFile(file As String)
filecounter = filecounter + 1
Debug.Print "File: " & filecounter & ": " & file
End Sub
答案 2 :(得分:0)
所以,这是我搜索文件夹以查找特定文件类型的方法。 (在开发的这个阶段,早期绑定是你的朋友)。确保已启用Microsoft Scripting Runtime引用。
Option Explicit
Sub test()
Dim fso As Scripting.FileSystemObject
Dim fsoMainDirectory As Scripting.Folder
Dim fsoSubfolder As Scripting.Folder
Dim fsoFile As Scripting.File
Dim strFilePath
Set fso = New Scripting.FileSystemObject
Set fsoMainDirectory = fso.GetFolder("Directory, with trailing \")
For Each fsoFile In fsoMainDirectory.Files
If fsoFile.Type = "Microsoft Excel 97-2003 Worksheet" Then '.xls file type
strFilePath = fsoFile.Path
Application.Workbooks.Open strFilePath
End If
Next fsoFile
End Sub
您的子文件夹有多深?你是唯一一个会使用这个宏吗?循环使用具有未知数量的子文件夹的n个子文件夹是可行的,但我的方法涉及一组计数器。此阵列可能会降低性能,因此如果我们不需要,则不希望这样做。