Boucle à Travers Tous les Dossiers et Tous ses sous-dossiers VBA

je sais que la question a été posée de nombreuses fois avant, j'ai vérifié les suggestions précédentes, mais je ne pouvais pas faire mon code à exécuter.

Donc, j'ai un dossier appelé "Rapport" qui contient plusieurs dossiers. Ces dossiers contient .xlsx et .les fichiers zip.

Chaque fichier contient également un dossier appelé "2016" et sous elle, 12 dossiers "janvier", "février",..., "décembre".

Voici un exemple d'un sous-dossier
Boucle à Travers Tous les Dossiers et Tous ses sous-dossiers VBA

Ce que je veux faire est de faire une boucle par tous ces sous-dossiers et déplacer la .xlsx et .les fichiers zip pour le mensuel dossier basé sur createdDate.

Par exemple, tous les .xlsx et .zip dans un lieu créé en novembre, ils seront déplacés vers le dossier "novembre", "2016" dans le même emplacement.

J'ai créé cette macro, mais c'est beaucoup de temps car à chaque fois que j'ai besoin de changer le chemin d'accès de chaque subfloder et l'exécuter pour chaque sous-dossier.

Sub Move_Files_To_Folder()

Dim Fso As Object
Dim FromPath As String
Dim ToPath As String
Dim FileInFromFolder As Object

'Change Path
FromPath = "C:\Report\Shipment\"
ToPath = "C:\Report\Shipment16\"

Set Fso = CreateObject("scripting.filesystemobject")

For Each FileInFromFolder In Fso.GetFolder(FromPath).Files

'Change month and year
If (Month(FileInFromFolder.DateCreated)) = 11 And (year(FileInFromFolder.DateCreated)) = 2016 _
And (InStr(1, FileInFromFolder.name, ".xlsx") Or InStr(1, FileInFromFolder.name, ".zip")) Then
FileInFromFolder.Move (ToPath & MonthName(Month(FileInFromFolder.DateCreated)) & "\")
End If

Next FileInFromFolder

End Sub

Je veux automatiser ma macro afin qu'il fonctionne sur tous les sous-dossiers et non Pas un par un, et de changer le chemin d'accès à chaque fois.
Toutes les suggestions s'il vous plaît ? Je vous remercie beaucoup.

mrexcel.com/forum/excel-questions/... ce sera de manière récursive regarder à travers des dossiers.

OriginalL'auteur JuniorDev | 2016-11-22

  1. 8

    Contrairement à @luke_t et @Lowpar, je ne pense pas que la boucle récursive, à la recherche dans tous les sous-dossiers et de fichiers est une bonne réponse ici, parce que quand vous aller au fond du dossier (c'est à dire C:\Report\Shipment\2016\May\), vous obtiendrez et déplacer des fichiers qui sont déjà à la bonne place.

    Grâce au fait que vous avez résolu la structure de dossiers, vous pouvez simplement faire une boucle par tous les .xlsx et .zip fichier dans chaque sous-dossier du dossier principal (C:\Report\).

    Sub Move_Files_To_Folder()

Dim Fso As Object, objFolder As Object, objSubFolder As Object
Dim FromPath As String
Dim FileInFolder As Object

FromPath = "C:\Report\"
Set Fso = CreateObject("Scripting.filesystemobject")
Set objFolder = Fso.GetFolder(FromPath)

For Each objSubFolder In objFolder.subfolders
    For Each FileInFolder In objSubFolder.Files

        If InStr(1, FileInFolder.Name, ".xlsx") Or InStr(1, FileInFolder.Name, ".zip") Then
            FileInFolder.Move (objSubFolder.path & "16\" & MonthName(Month(FileInFolder.DateCreated)) & "\")
        End If

    Next FileInFolder
Next objSubFolder

End Sub

    Cependant, si la structure de dossiers serait dynamique, l'approche proposée @luke_t serait plus approprié.

    OriginalL'auteur Limak

  2. 4

    Je voudrais suggérer à l'aide d'une fonction récursive pour obtenir le niveau inférieur de la structure de dossier.

    Ci-dessous la fonction de parcourir tous les sous-dossiers du dossier fourni.

    Une fois que la fonction a atteint le niveau inférieur de la structure de dossier, il commencera alors pour itérer sur chaque fichier, en le déplaçant si nécessaire (vous entrez le code pour effectuer cette tâche, où j'ai mis un commentaire dans l'exemple ci-dessous).

    Vous devez activer Microsoft Scripting Runtime de référence (VBE -> Outils> Références)

    Option Explicit

Public Sub move_documents()

    Dim fSystem As Scripting.FileSystemObject
    Dim fp As String

    Set fSystem = New Scripting.FileSystemObject
    fp = "C:\xyz" ' Enter your folder start location

    find_folders fSystem.GetFolder(fp)

End Sub

Private Function find_folders(ByVal fldr As Folder)

    Dim sf As Folder

    For Each sf In fldr.SubFolders
        find_folders sf, ws
    Next

    ' Enter function or code to move each file in a folder here.

End Function

    OriginalL'auteur luke_t