特定のフォルダとそのサブフォルダのリストをループするVBAマクロ

Question

パスからすべてのフォルダとそのサブフォルダをループするソリューションを作成し、条件に基づいてファイルを移動します。

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 

うまくいきましたが、私のパスとすべてのサブフォルダの下の特定のフォルダを使ってマクロをループに調整したかったのです。

代わりにFor Each objSubFolder In objFolder.subfolders私はループするために私のパスの下にフォルダの名前を含む配列リストを作成したいと思います。要約ように、この

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 

よう

何かが、私の解決策の私のパスの下にあるすべてのフォルダとサブフォルダをループし、私は私の道の下のフォルダとそのすべてのサブフォルダのリストにそれを調整したいです。

私はこのarrayを作成してFor Eachに追加しようとしましたが、毎回実行するとその行にエラーが発生します。どのような提案を正しく書く方法を教えてください？どうもありがとうございました。

Answer 1

毎回、配列を繰り返して、毎回objFolderの新しいパスを作成してください。 これは動作するはずです：

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 

Answer 2

あなたは、Dictionaryオブジェクト（スクリプトライブラリ）を使用し、各サブフォルダ名

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.. 

のためにそれを見えるかもしれません