VBScriptで子フォルダ、孫フォルダ・・・のファイルを親フォルダに集める

下記のように、子フォルダ、孫フォルダ・・・それぞれにファイルが入っている場合で、ファイルを一か所に集めたいときに使います。

親フォルダ
│  file-2.txt 
│  file.txt 
│ 
├─child-1 
│  │  file-2.txt 
│  │  file.txt 
│  │ 
│  ├─child-child-1 
│  │      file-2.txt 
│  │      file.txt 
│  │ 
│  └─child-child-2 
│          file-2.txt 
│          file.txt 
│ 
└─child-2 
    │  file-2.txt 
    │  file.txt 
    │ 
    ├─child-child-1 
    │      file-2.txt 
    │      file.txt 
    │ 
    └─child-child-2 
            file-2.txt 
            file.txt

実行後は下記のように子フォルダ、孫フォルダにあるすべてのファイルを親フォルダに集めます。ファイル名が重複した場合は拡張子の前に「(n)」と数字をつけて、ファイル名が重複しないようにします。

親フォルダ
│  file(1).txt
│  file(2).txt
│  file(3).txt
│  file(4).txt
│  file(5).txt
│  file(6).txt
│  file-2(1).txt
│  file-2(2).txt
│  file-2(3).txt
│  file-2(4).txt
│  file-2(5).txt
│  file-2(6).txt
│  file-2.txt
│  file.txt
│
├─child-1
│  ├─child-child-1
│  └─child-child-2
└─child-2
    ├─child-child-1
    └─child-child-2

コードは下記です。これをメモ帳にコピー＆ペーストして、拡張子「.vbs」で保存し、ダブルクリックしてください。
フォルダ選択画面が表示されますので、親フォルダを指定してください。フォルダを選択すると実行可否を尋ねるダイアログが表示されます。非常に危険なので、ダイアログのボタンの既定値は「いいえ」にしてあります。「はい」をクリックすると、指定したフォルダ、そのすべてのサブフォルダ、そのすべてのサブフォルダ……の中のファイルがすべて親フォルダに移動されます。終了後にメッセージ「ファイル移動が完了しました」が表示されます（このメッセージは、移動対象のファイルが全くなく、ファイル移動を実施していない時にも表示されます）。
本ブログラムの実行結果に作者は責任を持ちません。動かしてはいけないファイルがあるフォルダは絶対に指定しないでください。ファイルを移動できない場合もありえます。また、大量のサブフォルダやファイルがあるフォルダを指定すると、長い待ち時間が発生したりPCがフリーズしたりする可能性があります。

Option Explicit
Private Const TARGET_EXTENTION = ""     '「jpg」などを指定可能

Call main
 
Sub main()
    Dim baseFolderPath
    Dim FSO
    Dim tempFolder
    Dim msg
    
    baseFolderPath = selectForder
    If baseFolderPath = "" Then
        Exit Sub
    End If
     
    msg = "下記のフォルダのサブフォルダの配下にある"
    
    If Not TARGET_EXTENTION = "" Then
        msg = msg & "「" & TARGET_EXTENTION & "」"
    
    End If
    
    
    msg = msg & "ファイルをすべて下記のフォルダに移動します。" _
            & vbCrLf & "本当によろしいですか？ " _
            & "（この操作は取り消しできません）" _
            & vbCrLf & vbCrLf & baseFolderPath
     
    If MsgBox(msg, vbYesNo + vbCritical + vbDefaultButton2) = vbNo Then
        Exit Sub
    End If
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each tempFolder In FSO.getFolder(baseFolderPath).SubFolders
        Call moveFiles(tempFolder, baseFolderPath)
    Next
    Set tempFolder = Nothing
    Set FSO = Nothing
    
    Call MsgBox("ファイル移動が完了しました。", vbInformation)
End Sub
 
Private Function selectForder()
    Dim objShell
    Dim objFolder
     
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, "サブフォルダにある「" _
            & TARGET_EXTENTION & _
            "」ファイルを移動したいフォルダを選択してください。", 0)
     
    selectForder = ""
    If Not objFolder Is Nothing Then
        selectForder = objFolder.Items.Item.Path
    End If
     
    Set objShell = Nothing
    Set objFolder = Nothing
End Function
 
Private Sub moveFiles(baseFolder, distinationFolderPath)
    Dim FSO
    Dim tempFile
    Dim tempFolder
    Dim tempPath
     
    Set FSO = CreateObject("Scripting.FileSystemObject")
     
    For Each tempFile In baseFolder.Files
        If TARGET_EXTENTION = "" Or FSO.GetExtensionName(tempFile.Name) = TARGET_EXTENTION Then
            tempPath = distinationFolderPath & "\" & tempFile.Name
            tempPath = getUniquePath(tempPath)
            tempFile.Move (tempPath)
        End If
    Next
     
    For Each tempFolder In baseFolder.SubFolders
        Call moveFiles(tempFolder, distinationFolderPath)
    Next
     
    Set FSO = Nothing
    Set tempFile = Nothing
    Set tempFolder = Nothing
End Sub

Private Function getUniquePath(targetPath)
    Dim FSO
    Dim tempFilePath
    Dim tempFileBaseName
    Dim i
    
    tempFilePath = targetPath
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    
    tempFileBaseName = FSO.GetBaseName(tempFilePath)
    
    i = 1
    Do Until Not (FSO.FileExists(tempFilePath))

        tempFilePath = FSO.GetParentFolderName(tempFilePath) & "\" _
        & tempFileBaseName & "(" & i & ")." _
        & FSO.GetExtensionName(tempFilePath)
        
        i = i + 1
    Loop
    
    getUniquePath = tempFilePath
    
    Set FSO = Nothing
End Function

実行結果を確認するには、コマンドプロンプトで対象のフォルダに移動し、

cd 対象のフォルダ

treeコマンドでフォルダツリーを確認します。

tree /f

実行例

C:\Users\misya\Desktop\test> tree /f
フォルダー パスの一覧:  ボリューム Windows
ボリューム シリアル番号は 000000FE 4603:56D4 です
C:.
│  file1
│  file1(1)
│  file1(1).jpg
│  file1(1).txt
│  file1(2)
│  file1(2).jpg
│  file1(2).txt
│  file1.jpg
│  file1.txt
│  file2
│  file2(1)
│  file2(1).jpg
│  file2(1).txt
│  file2(2)
│  file2(2).jpg
│  file2(2).txt
│  file2.jpg
│  file2.txt
│
├─child-1
│  ├─child-child-1
│  └─child-child-2
└─child-2
    ├─child-child-1
    └─child-child-2

プログラムの2行目を下記のように変更することで、特定の拡張子のファイルだけを移動することができます。拡張子を指定しない場合を""（空文字列）としたので、拡張子なしのファイルだけを移動することはできません。