ファイル名に従ってフォルダを振り分けて格納するマクロ

エクセルのファイル名に従って

フォルダを振り分けて



格納するマクロ

コード

Sub フォルダ振り分け()
    Dim Path As String
    Dim FileName As String
    Dim FolderName As String
    
    'フォルダのパスを取得
    Path = ThisWorkbook.Path & "\"
   
    'フォルダの中で拡張子が.xlsxのファイルを取得
    FileName = Dir(Path & "*.xlsx")
    
    '繰り返し処理
    Do While FileName <> ""
     
        'ファイル名の（から左を振り分け先のフォルダ名とする
        FolderName = Left(FileName, InStr(FileName, "(") - 1)
        'ファイルを移動
        Name Path & FileName As Path & FolderName & "\" & FileName

    '次のファイルを取得
    FileName = Dir

    Loop
    
    MsgBox "格納完了"
    
End Sub

注意点

• ファイル名の（から左側と同じ名前のフォルダがないとエラーになる
• すでに同じ名前のファイルが格納されているとエラーになる