CODEWITHSUNDEEP
vbaexcelmacros
JuniorDev
JuniorDev

Reputation: 453

Loop through a specific list of folders and their subFolders VBA Macro

i have created a solution to Loop through all folders and their SubFolders from a path then move files based on a condition. 

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:\Reports\"
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 & "\2016\" & MonthName(Month(FileInFolder.DateCreated)) & "\")
        End If

    Next FileInFolder
Next objSubFolder

End Sub

It works fine but i wanted to adjust my macro to Loop through specific folders under my path and all their SubFolders.

So instead of For Each objSubFolder In objFolder.subfolders I want to create an array list which contains the names of folders under my path to loop through.

Something like this 

FoldersName = Array("Shipment", "Backlog", "Released", "Unreleased") 
For Each objSubFolder In objFolder.FoldersName
For Each FileInFolder In objSubFolder.Files
'rest of my code
Next FileInFolder
Next objSubFolder

So as a summary, my solution loop through all folders and subFolders under my path and i want to adjust it to a list of folders under my path and all their subFolders.

I have tried to create this array and add it to the For Each but everytime i run i get the error in that line. Any suggestions please how to write it correctly ? Thank you very much.

Upvotes: 1

Views: 2212

Answers (2)

A.S.H
A.S.H

Reputation: 29332

You might use a Dictionary object (Scripting library) and look it up for each subfolder name 

Dim dic As Object
Set dic = CreateObject("Scripting.dictionary")
For Each word In Array("Shipment", "Backlog", "Released", "Unreleased")
    dic.Add word, word
Next

For Each objSubFolder In objFolder.SubFolders
    If dic.contains(objSubFolder.Name) Then
    'etc etc..

Upvotes: 1

Kelaref
Kelaref

Reputation: 517

Just iterate through the array create a new path fo objFolder every time. This should work: 

Sub Move_Files_To_Folder()

Dim Fso As Object, objFolder As Object, objSubFolder As Object
Dim FromPath As String
Dim FileInFolder As Object, i as integer

FoldersName = Array("Shipment", "Backlog", "Released", "Unreleased") 
FromPath = "C:\Reports\"
Set Fso = CreateObject("Scripting.filesystemobject")

for i = 1 to ubound(FoldersName)

  Set objFolder = Fso.GetFolder(FromPath & FoldersName(i) & "\")

  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 & "\2016\" & MonthName(Month(FileInFolder.DateCreated)) & "\")
        End If

    Next FileInFolder
Next objSubFolder
next

End Sub

Upvotes: 1

Related Questions