見出し画像

【ファイル付き】コピペで使えるExcelマクロ！ファイルの保存場所を一括で移動するマクロの使い方

【フォロバ100%】ひこすけ@現役ITコンサル

今回の記事では、Excel VBAを用いてフォルダ内のファイル一覧を取得し、それらのファイルを指定フォルダに移動する一連のマクロについてご紹介します。このプロジェクトには、３つの関連するマクロが含まれており、特にフォルダパスの取得が分からない方にも使いやすいように工夫されています。以下の章立てに沿って、それぞれのマクロの概要やコードの解説、実際の使用方法をご説明します。

Excelマクロの基本的な使い方は、下の記事を参考にしてください



1. マクロの概要

このプロジェクトには大きく分けて3つのマクロが登場します。

  1. SelectFolderAndListAllFiles
    ユーザーにフォルダを選択させ、そのフォルダ内およびサブフォルダ内のすべてのファイルをリスト化するマクロです。取得したファイルパスはアクティブシートのA列に記録されます。

  2. MoveFilesWithLogging
    1つ目のマクロで取得したファイル一覧を基に、ファイルを指定されたフォルダに移動するマクロです。移動の際に重複が発生する場合は連番を付与し、処理結果をログとしてC列に記録します。

  3. ShowFolderPath
    補助的なマクロで、フォルダ選択ダイアログを表示し、選択したフォルダパスをシートのセルE2に表示します。これにより、フォルダパスをコピーして他のセルやマクロで使用できるようになります。

この3つのマクロは連携して動作します。まず1つ目のマクロでファイル一覧を取得し、次に2つ目のマクロでファイル移動を行う想定です。その際、必要に応じて3つ目のマクロを利用してフォルダパスを確認することができます。

2. コードの説明

以下が実際に使用するコードです。
2種類のコード両方を使用します。必要に応じて3つ目のコードも使用します
このコードをコピーして、標準モジュールに貼り付けるだけで使用可能です。
コードをどうやって貼り付けて使用していいかわからない方は、この記事の上部に、Excelマクロの基本操作の記事のリンクを貼っているためそちらを参照してください。

1つ目のコード

Sub SelectFolderAndListAllFiles()
    Dim folderDialog As FileDialog
    Dim selectedFolderPath As String
    Dim fileSystemObject As Object
    Dim folder As Object
    Dim ws As Worksheet
    Dim lastRow As Long

    ' アクティブなシートを設定
    Set ws = ThisWorkbook.ActiveSheet

    ' フォルダ選択ダイアログを表示
    Set folderDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With folderDialog
        .Title = "フォルダを選択してください"
        .AllowMultiSelect = False
        If .Show = -1 Then
            selectedFolderPath = .SelectedItems(1)
        Else
            MsgBox "フォルダが選択されませんでした。", vbExclamation
            Exit Sub
        End If
    End With

    ' ファイルシステムオブジェクトを使用してファイルを取得
    Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
    Set folder = fileSystemObject.GetFolder(selectedFolderPath)

    ' A列の最後の空白行を取得
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row + 1

    ' サブフォルダを含むすべてのファイル情報をリストアップ
    Call ListFilesRecursive(folder, ws, lastRow)

    MsgBox "フォルダ内およびサブフォルダ内のすべてのファイル情報を取得しました。", vbInformation
End Sub

Sub ListFilesRecursive(targetFolder As Object, ws As Worksheet, ByRef lastRow As Long)
    Dim file As Object
    Dim subFolder As Object

    ' フォルダ内のすべてのファイルのフルパスをリストアップ
    For Each file In targetFolder.Files
        ws.Cells(lastRow, 1).Value = file.Path ' フルパスを取得して記録
        lastRow = lastRow + 1
    Next file

    ' サブフォルダを再帰的に処理
    For Each subFolder In targetFolder.SubFolders
        Call ListFilesRecursive(subFolder, ws, lastRow)
    Next subFolder
End Sub

2つ目のコード

Sub MoveFilesWithLogging()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim srcPath As String
    Dim destFolder As String
    Dim destPath As String
    Dim fileName As String
    Dim newFileName As String
    Dim fileExt As String
    Dim counter As Integer
    Dim fso As Object
    Dim logMessage As String
    
    ' ワークシートと範囲の設定
    Set ws = ThisWorkbook.Sheets(1) ' 1枚目のシートを想定
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    ' 2行目から最終行までループ
    For i = 2 To lastRow
        srcPath = ws.Cells(i, "A").Value
        destFolder = ws.Cells(i, "B").Value
        logMessage = ""
        
        If fso.FileExists(srcPath) Then
            If fso.FolderExists(destFolder) Then
                ' ファイル名と拡張子を取得
                fileName = fso.GetFileName(srcPath)
                fileExt = fso.GetExtensionName(srcPath)
                destPath = fso.BuildPath(destFolder, fileName)
                
                ' 移動先に同名ファイルがある場合は連番をつける
                newFileName = fileName
                counter = 1
                While fso.FileExists(destPath)
                    newFileName = Replace(fileName, "." & fileExt, "(" & counter & ")." & fileExt)
                    destPath = fso.BuildPath(destFolder, newFileName)
                    counter = counter + 1
                Wend
                
                ' ファイルを移動
                On Error Resume Next
                fso.MoveFile srcPath, destPath
                If Err.Number = 0 Then
                    logMessage = "成功: " & newFileName
                    If counter > 1 Then
                        logMessage = logMessage & "（重複していたため連番を付加）"
                    End If
                Else
                    logMessage = "失敗: ファイルを移動できませんでした"
                End If
                On Error GoTo 0
            Else
                logMessage = "失敗: 移動先のフォルダが見つかりません"
            End If
        Else
            logMessage = "失敗: ファイルが見つかりません"
        End If
        
        ' C列にログメッセージを記入
        ws.Cells(i, "C").Value = logMessage
    Next i
    
    ' 後処理
    Set fso = Nothing
    MsgBox "処理が完了しました。", vbInformation
End Sub

３つ目のコード

Sub ShowFolderPath()
    ' フォルダ選択ダイアログ用の変数
    Dim folderPicker As FileDialog
    Dim selectedFolderPath As String
    
    ' フォルダ選択ダイアログを作成
    Set folderPicker = Application.FileDialog(msoFileDialogFolderPicker)
    
    ' ダイアログの設定
    With folderPicker
        .Title = "フォルダを選択してください"
        .AllowMultiSelect = False ' 複数選択を無効化
        
        ' ユーザーがフォルダを選択した場合
        If .Show = -1 Then
            selectedFolderPath = .SelectedItems(1) ' 選択されたフォルダパスを取得
            ' E2セルにパスを表示
            ThisWorkbook.Sheets(1).Range("E2").Value = selectedFolderPath
        Else
            MsgBox "フォルダが選択されませんでした。", vbExclamation, "選択キャンセル"
        End If
    End With
    
    ' オブジェクトを解放
    Set folderPicker = Nothing
End Sub

3. 使い方

これらのマクロを利用する手順は以下の通りです。

  1. マクロの準備: ExcelのVBAエディタを開き、上記の3つのマクロのコードを適切なモジュールに貼り付けます。

  2. フォルダの選択とファイル一覧の取得
    まず、SelectFolderAndListAllFiles マクロを実行します。

    • 実行するとフォルダ選択ダイアログが表示されるので、対象のフォルダを選択します。

    • 選択されたフォルダ内およびサブフォルダ内のすべてのファイルのパスが、アクティブシートのA列にリストされます。

  3. フォルダパスの確認（必要に応じて）
    次に、ShowFolderPath マクロを実行して、フォルダパスをセルE2に表示します。

    • 表示されたパスをコピーして、移動先フォルダの指定などに利用することができます。

    • 特にフォルダパスの取得方法が分からない場合、この手順を使うと便利です。

  4. ファイルの移動
    MoveFilesWithLogging マクロを実行します。

    • このマクロは、A列にリストされたファイルを、対応するB列に指定されたフォルダへ移動します。

    • 移動の結果やエラーについては、C列にログとして表示されます。

    • 同じファイル名が存在する場合は、自動的に連番が付与されてリネームされます。

  5. 結果の確認

    • ファイルが正しく移動されているか、シート上のログ（C列）を確認します。

    • エラーが発生した場合は、ログメッセージをもとに対処します。

4. ファイルの配布

実際のファイルも置いておきます。これをダウンロードして使用することも可能です。

5. まとめ

この記事では、Excel VBAを使用してフォルダ内のファイル一覧を取得し、それらを別のフォルダに移動する一連のマクロについて紹介しました。

  • SelectFolderAndListAllFiles マクロでファイルリストを取得し、

  • 補助的な ShowFolderPath マクロでフォルダパスをセルに表示し、

  • MoveFilesWithLogging マクロでファイルの移動とログ記録を行います。

この3つのマクロを組み合わせることで、フォルダ内のファイル管理がより効率的に行えるようになります。特にフォルダパスの取得や重複ファイルの扱いに配慮した設計になっているため、初心者の方でも安心して使用できます。ぜひ、自分の環境に合わせて応用してみてください。

この記事で紹介したマクロをさらにカスタマイズしたい場合や、エラーが発生する場合は、お気軽にコメントをお寄せください！

※本記事で紹介しているマクロやファイルの使用に伴い発生したいかなるトラブルや損害についても、当方では一切の責任を負いかねます。すべて自己責任のもとでご利用ください。


いいなと思ったら応援しよう！