VBA Dirはネストできない？

こんにちは。
派犬事務員のコロ子です。

Dirの謎？

先日、こんな依頼があった。

ある「フォルダA」に下記のようなエクセルファイルがある。

別の「フォルダB」に下記のようなフォルダがある。

フォルダAのエクセルファイルをフォルダBの同じ名前のフォルダに入れたい。
その数500～600個。

Aさん：「急ぎでも必須でもないけど、フォルダの中身を整理したいんだよね。でも手作業でやるのは大変過ぎるんだよね。なんとかならない？」

コロ子：「こんなのなら簡単です。すぐできます！」

めっちゃ安請け合して、１回使うだけだから雑でもいいからささっと作って、ちゃっちゃっと終わらせようとこんなコードを書いてみたところ・・・。

Sub Move_File()

Dim fileName As String
'フォルダAの中のファイル名を取得
fileName = Dir(ThisWorkbook.Path & "\フォルダA\*.xlsx")

Do While fileName <> ""

    Dim folderName As String
    'フォルダBの中のフォルダ名を取得
    folderName = Dir(ThisWorkbook.Path & "\フォルダB\", vbDirectory)
    
    Do While folderName <> ""
    
        If Left(fileName, 5) = folderName Then
            
            Name ThisWorkbook.Path & "\フォルダA\" & fileName As _
                 ThisWorkbook.Path & "\フォルダB\" & folderName & "\" & fileName
        
        End If
        folderName = Dir()

    Loop
    
    fileName = Dir()

Loop

End Sub

あれ・・・？
上手くいかない。最初の一つしかできてない？

理由が良く分からないので分解して確認してみる。

フォルダA内のファイル名を取得する

Sub test1()

Dim fileName As String

fileName = Dir(ThisWorkbook.Path & "\フォルダA\*.xlsx")

Do While fileName <> ""

    Debug.Print fileName
    fileName = Dir()

Loop

End Sub

イミディエイトウインドウ

AAA-1-ファイル.xlsx
AAA-2-ファイル.xlsx
AAA-3-ファイル.xlsx
AAA-4-ファイル.xlsx
BBB-1-ファイル.xlsx
BBB-2-ファイル.xlsx
BBB-3-ファイル.xlsx

問題なし。

フォルダBのフォルダ名を取得する

Sub test2()

Dim folderName As String
folderName = Dir(ThisWorkbook.Path & "\フォルダB\", vbDirectory)

Do While folderName <> ""

    Debug.Print folderName
    folderName = Dir()

Loop

End Sub

イミディエイトウインドウ

.
..
AAA-1
AAA-2
AAA-3
AAA-4
BBB-1
BBB-2
BBB-3

これも問題なし。
（「.」は自分自身のフォルダ、「..」は1つ上のフォルダ。Dir(パス, vbDirectory)でフォルダを取得すると「.」と「..」も取得する。）

あとは、疑わしきはファイルの移動
「Name パス\古い名前 As パス\新しい名前」で移動する。
試しに1つやってみる。

Sub test3()

Name ThisWorkbook.Path & "\フォルダA\AAA-1-ファイル.xlsx" As _
     ThisWorkbook.Path & "\フォルダB\AAA-1\AAA-1-ファイル.xlsx"

End Sub

これも問題なし。

でもやっぱりDirが疑わしいので調べたところ

fileName = Dir(パターン)
最初にパターンに一致するファイル（フォルダの名前etc）を文字列で返す。
fileName = Dir()
次にパターンに一致するファイル（フォルダの名前etc）を文字列で返す。

途中で違うパターンを挟んでみると

Sub test4()

Dim fileName As String

'パターンA　フォルダAの中身
fileName = Dir(ThisWorkbook.Path & "\フォルダA\*.xlsx")
Debug.Print fileName

fileName = Dir()
Debug.Print fileName


'途中で別のパターンを挟む
'パターンB　フォルダBの中身
Dim folderName As String

folderName = Dir(ThisWorkbook.Path & "\フォルダB\", vbDirectory)
Debug.Print folderName

folderName = Dir()
Debug.Print folderName

folderName = Dir()
Debug.Print folderName

folderName = Dir()
Debug.Print folderName

End Sub

イミディエイトウインドウ

AAA-2-ファイル.xlsx
AAA-3-ファイル.xlsx
.
..
AAA-1
AAA-2

途中でパターンを変えると最初のパターンは上書きされてなくなっちゃう！

それにしてもDirって変な関数、というか奥が深い。

う～ん、こういう場合は諦めてFSO（FileSystemObject）を使うしかないかぁ。
（FSOを使う場合は「Microsoft Scripting Runtime」の参照設定を忘れずに！）

DirとFSOと組み合わせ
一回だけ使う分にはこれで十分。

Sub test5()

'DirとFSOと組み合わせ

Dim fileName As String

'フォルダA中のファイルはDirで取得
fileName = Dir(ThisWorkbook.Path & "\フォルダA\*.xlsx")

Do While fileName <> ""

    'フォルダB中のフォルダはFSOで取得
    Dim fso As FileSystemObject
    Set fso = New FileSystemObject
    
    Dim folderPath As Folder
    Set folderPath = fso.GetFolder(ThisWorkbook.Path & "\フォルダB\")
    
    Dim folderName As Folder
    
    For Each folderName In folderPath.SubFolders

        If Left(fileName, 5) = folderName.Name Then
        
            Name ThisWorkbook.Path & "\フォルダA\" & fileName As folderName & "\" & fileName
            Exit For
        
        End If
    
    Next folderName

    
    fileName = Dir()

Loop


End Sub

統一感を出すために両方FSOを使う場合

Sub test7()

Dim fso As FileSystemObject
Set fso = New FileSystemObject

Dim filePath As Folder
Set filePath = fso.GetFolder(ThisWorkbook.Path & "\フォルダA\")

Dim fileName As File

For Each fileName In filePath.Files

    Dim folderPath As Folder
    Set folderPath = fso.GetFolder(ThisWorkbook.Path & "\フォルダB\") 
    
    Dim folderName As Folder
    
    For Each folderName In folderPath.SubFolders

        If Left(fileName.Name, 5) = folderName.Name Then
        
            Name filePath & "\" & fileName.Name As folderName & "\" & fileName.Name
            Exit For
        
        End If
    
    Next folderName

Next fileName

End Sub

教訓

簡単だと思ったのに、結局つまずいてすぐにできなかった。
「すぐできます」とか言うのはやめるべし！