循环遍历文件夹的各个子文件夹和这些子文件夹的每个文件时出现问题

时间:2017-07-27 10:19:29

标签: vba excel-vba loops directory excel

我想访问当前文件夹的每个子文件夹(每个子文件夹中的子文件夹数量可能不同),然后想要在所有这些子文件夹的每个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项目中已添加工具设置中的所有必需参考。请帮助我使用此代码。

3 个答案:

答案 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个子文件夹是可行的,但我的方法涉及一组计数器。此阵列可能会降低性能,因此如果我们不需要,则不希望这样做。