excel - todos - mover varios archivos en linux

Haga un ciclo a través de subcarpetas y archivos en un directorio raíz especificado por el usuario

Question

Esta pregunta ya tiene una respuesta aquí:

• obtener lista de subdires en vba 4 respuestas

Mi script cíclico a través de archivos individuales funciona bien, pero ahora necesito que también busque en / para múltiples directorios. Estoy atascado....

El orden en que las cosas deben suceder:

• Se le pide al usuario que elija el directorio raíz de lo que necesitan
• Necesito el script para buscar cualquier carpeta en ese directorio raíz
• Si el script encuentra uno, abre el primero (todas las carpetas, por lo que no hay filtro de búsqueda específico para las carpetas)
• Una vez abierto, mi secuencia de comandos recorrerá todos los archivos de las carpetas y hará lo que debe hacer.
• una vez finalizado, cierra el archivo, cierra el directorio y pasa al siguiente, etc.
• Bucles hasta que se hayan abierto / escaneado todas las carpetas

Esto es lo que tengo, que no funciona y sé que está mal:

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

Código final. Se desplaza por todos los subdirectorios y archivos en cada subdirectorio.

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

Answer 1

Es posible que le resulte más fácil usar FileSystemObject , algo así como esto

Esto arroja una carpeta / lista de archivos a la 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

Answer 2

Aquí hay una solución VBA, sin usar objetos externos.

Debido a las limitaciones de la función Dir() , necesita obtener todo el contenido de cada carpeta a la vez, no mientras rastrea con un algoritmo recursivo.

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

Answer 3

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