사용자 지정 루트 디렉터리의 하위 폴더 및 파일 순환

사용자 지정 루트 디렉터리의 하위 폴더 및 파일 순환

이 질문에는 이미 다음과 같은 답변이 있습니다.

VBA의 하위 디렉토리 목록 가져오기 (5개 답변)

닫힘6년 전에.

개별 파일을 순환하는 스크립트는 정상적으로 작동하지만, 여러 디렉토리를 검색하기 위해서도 스크립트가 필요합니다.난 꼼짝도 못 하고...

다음과 같은 순서가 필요합니다.

• 사용자에게 필요한 루트 디렉터리를 선택하라는 메시지가 나타납니다.
• 루트 디렉터리에 있는 폴더를 찾으려면 스크립트가 필요합니다.
• 스크립트가 찾을 경우 첫 번째 폴더가 열립니다(모든 폴더, 폴더에 대한 특정 검색 필터 없음).
• 스크립트가 열리면 폴더에 있는 모든 파일을 순환하여 필요한 작업을 수행합니다.
• 이것이 끝나면 파일을 닫고 디렉토리를 닫고 다음으로 이동합니다.
• 모든 폴더가 열리거나 검색될 때까지 루프

이것이 제가 가지고 있는 것입니다. 이것은 효과가 없고 잘못되었다는 것을 압니다.

MsgBox "Please choose the folder."
Application.DisplayAlerts = False
With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = "\\blah\test\"
    .AllowMultiSelect = False
    If .Show <> -1 Then MsgBox "No folder selected! Exiting script.": Exit Sub
    CSRootDir = .SelectedItems(1)
End With
folderPath = Dir(CSRootDir, "\*")

Do While Len(folderPath) > 0
    Debug.Print folderPath
    fileName = Dir(folderPath & "*.xls")
    If folderPath <> "False" Then
        Do While fileName <> ""
            Application.ScreenUpdating = False
            Set wbkCS = Workbooks.Open(folderPath & fileName)

            --file loop scripts here

        Loop  'back to the Do
Loop    'back to the Do

최종 코드.각 하위 디렉토리의 모든 하위 디렉토리와 파일을 순환합니다.

Dim FSO As Object, fld As Object, Fil As Object
Dim fsoFile As Object 
Dim fsoFol As Object 
Dim fileName As String

    MsgBox "Please choose the folder."
    Application.DisplayAlerts = False
    With Application.FileDialog(msoFileDialogFolderPicker)
         .InitialFileName = "\\blah\test\"
         .AllowMultiSelect = False
         If .Show <> -1 Then MsgBox "No folder selected! Exiting script.": Exit Sub
         folderPath = .SelectedItems(1)
    End With

    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
         Set FSO = CreateObject("Scripting.FileSystemObject")
         Set fld = FSO.getfolder(folderPath)
    If FSO.folderExists(fld) Then
         For Each fsoFol In FSO.getfolder(folderPath).subfolders
              For Each fsoFile In fsoFol.Files
                   If Mid(fsoFile.Name, InStrRev(fsoFile.Name, ".") + 1) = "xls" Then
    fileName = fsoFile.Name
    Application.ScreenUpdating = False
    Set wbkCS = Workbooks.Open(fsoFile.Path)

    'My file handling code


                End If
              Next
         Next
    End If

사용하는 것이 더 쉽다는 것을 발견할 수 있습니다.FileSystemObject, 이와 같은 것

폴더/파일 목록을 에 덤프합니다.Immediate window

Option Explicit

Sub Demo()
    Dim fso As Object 'FileSystemObject
    Dim fldStart As Object 'Folder
    Dim fld As Object 'Folder
    Dim fl As Object 'File
    Dim Mask As String
    
    Set fso = CreateObject("scripting.FileSystemObject") ' late binding
    'Set fso = New FileSystemObject 'or use early binding (also replace Object types)
    
    Set fldStart = fso.GetFolder("C:\Your\Start\Folder") '-- use your FileDialog code here

    Mask = "*.xls"
    Debug.Print fldStart.Path & "\"
    ListFiles fldStart, Mask
    For Each fld In fldStart.SubFolders
        ListFiles fld, Mask
        ListFolders fld, Mask
    Next
End Sub


Sub ListFolders(fldStart As Object, Mask As String)
    Dim fld As Object 'Folder
    For Each fld In fldStart.SubFolders
        Debug.Print fld.Path & "\"
        ListFiles fld, Mask
        ListFolders fld, Mask
    Next

End Sub

Sub ListFiles(fld As Object, Mask As String)
    Dim fl As Object 'File
    For Each fl In fld.Files
        If fl.Name Like Mask Then
            Debug.Print fld.Path & "\" & fl.Name
        End If
    Next
End Sub

외부 객체를 사용하지 않는 VBA 솔루션이 여기에 있습니다.

의 한계 때문에.Dir()함수는 재귀적 알고리즘을 사용하여 크롤링하는 동안이 아니라 각 폴더의 전체 내용을 한 번에 가져올 필요가 있습니다.

Function GetFilesIn(Folder As String) As Collection
  Dim F As String
  Set GetFilesIn = New Collection
  F = Dir(Folder & "\*")
  Do While F <> ""
    GetFilesIn.Add F
    F = Dir
  Loop
End Function

Function GetFoldersIn(Folder As String) As Collection
  Dim F As String
  Set GetFoldersIn = New Collection
  F = Dir(Folder & "\*", vbDirectory)
  Do While F <> ""
    If GetAttr(Folder & "\" & F) And vbDirectory Then GetFoldersIn.Add F
    F = Dir
  Loop
End Function

Sub Test()
  Dim C As Collection, F

  Debug.Print
  Debug.Print "Files in C:\"
  Set C = GetFilesIn("C:\")
  For Each F In C
    Debug.Print F
  Next F

  Debug.Print
  Debug.Print "Folders in C:\"
  Set C = GetFoldersIn("C:\")
  For Each F In C
    Debug.Print F
  Next F
End Sub

Sub MoFileTrongCacFolder()

    Dim FSO As Object, fld As Object, Fil As Object
    Dim fsoFile As Object
    Dim fsoFol As Object
    Dim fileName As String
    Dim folderPath As String
    Dim wbkCS As Object

    MsgBox "Please choose the folder."
    Application.DisplayAlerts = False
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "\\blah\test\"
        .AllowMultiSelect = False
        If .Show <> -1 Then MsgBox "No folder selected! Exiting script.": Exit Sub
        folderPath = .SelectedItems(1)
    End With

    If Right(folderPath, 1) <> "\" Then folderPath = folderPath + "\"
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fld = FSO.getfolder(folderPath)
    If FSO.folderExists(fld) Then
        For Each fsoFol In FSO.getfolder(folderPath).subfolders
            For Each fsoFile In fsoFol.Files
                If Mid(fsoFile.Name, InStrRev(fsoFile.Name, ".") + 1) = "xls" Then
                    fileName = fsoFile.Name
                    Application.ScreenUpdating = False
                    Set wbkCS = Workbooks.Open(fsoFile.Path)

                    'My file handling code


                End If
            Next
        Next
    End If
End Sub

언급URL : https://stackoverflow.com/questions/14245712/cycle-through-sub-folders-and-files-in-a-user-specified-root-directory