Contents
この記事でできること
- VBAでフォルダを自動作成できる
- ファイル名のキーワードで自動振り分けできる
- セルの一覧からフォルダ名を読み取って一括作成＋ログ記録ができる
対象: Excel 2016以降 / Microsoft 365、Windows 10/11
完成イメージ（Before / After）
Sheet1の設定（実務版）
| A（フォルダ名） | B（キーワード） | C（ログ） | |
|---|---|---|---|
| 1 | フォルダ名 | キーワード | ログ |
| 2 | 売上報告 | 売上 | フォルダ作成済み |
| 3 | 議事録 | 議事録 | フォルダ作成済み |
| 4 | 経費 | 経費 | フォルダ作成済み |
Before（実行前）
元フォルダ（C:\Users\tanaka\Desktop\作業フォルダ\）：
売上_202601.xlsx
売上_202602.xlsx
議事録_0301.docx
経費精算_03.xlsx
その他メモ.txt振り分け先フォルダ（C:\Users\tanaka\Desktop\振り分け先\）：
（空）After（実行後）
元フォルダ：
その他メモ.txt ← キーワードに一致しないので残っている振り分け先フォルダ：
売上報告\
売上_202601.xlsx ← 「売上」キーワードで振り分け
売上_202602.xlsx ← 「売上」キーワードで振り分け
議事録\
議事録_0301.docx ← 「議事録」キーワードで振り分け
経費\
経費精算_03.xlsx ← 「経費」キーワードで振り分けSheet1のC列にログが記録される：
| C（ログ） | |
|---|---|
| 2 | 売上_202601.xlsx → 移動成功 / 売上_202602.xlsx → 移動成功 |
| 3 | 議事録_0301.docx → 移動成功 |
| 4 | 経費精算_03.xlsx → 移動成功 |
月初に12個のフォルダを手動で作って、100個のファイルを1個ずつドラッグ＆ドロップ。フォルダ名を打ち間違えたり、違うフォルダにファイルを入れてしまったり。毎月やっている割に毎月ミスが出る。
VBAで1クリック。フォルダ作成から振り分けまで10秒で完了する。実際にセル一覧から12フォルダを一括作成し、ファイル名のキーワードで自動振り分けしたら、30分かかっていた作業が10秒で終わった。しかもミスがない。
この記事では、フォルダの自動作成とファイルの振り分けを最小版と実務版の2パターンで紹介する。毎月のフォルダ整理に消耗している人に、まずは最小版で手軽さを体験してほしい。
フォルダ作成とファイル振り分けを自動化するだけで、毎月の定型作業が10秒で終わる。
実行前の準備
バックアップを取る（必須）
ファイル移動（Name文 / MoveFile）は、元フォルダからファイルがなくなる操作です。 間違ったフォルダに振り分けてしまうと、ファイルを探すのに手間がかかる。必ず元フォルダを丸ごとコピーしてバックアップを取ること。
手順：
- エクスプローラーで元フォルダを右クリック
- 「コピー」→ 同じ場所に「貼り付け」
- 「作業フォルダ – コピー」というバックアップが作られる
Excelをマクロ有効ブック（.xlsm）で保存する
- Excelを開く（新規でも既存でもOK）
- 「ファイル」→「名前を付けて保存」
- ファイルの種類を **「Excel マクロ有効ブック (*.xlsm)」** に変更して保存
.xlsx のままだとマクロは保存できない。必ず .xlsm にすること。
Windowsの拡張子を表示する
ファイル名で振り分けるため、拡張子（.xlsx .csv など）が見えている必要がある。Windowsの初期設定では拡張子が非表示のため、以下の手順で表示する。
- エクスプローラーを開く
- 上部メニューの「**表示**」タブをクリック
- 「**ファイル名拡張子**」にチェックを入れる
手順（コピペ → 実行まで約10分）
ステップ1：フォルダ名とキーワードを入力する（実務版の場合）
Sheet1 に以下のように入力する。
- A1：`フォルダ名`（ヘッダー）
- B1：`キーワード`（ヘッダー）
- A2以降：作成したいフォルダ名
- B2以降：振り分けに使うキーワード（ファイル名に含まれる文字列）
入力を楽にする方法: フォルダ名が決まっている場合は手入力でOK。元フォルダのファイル名を確認したい場合は フォルダ内のファイル一覧を自動出力する方法 でA列にファイル名を出力すると、キーワードの検討がしやすい。
ステップ2：VBEを開いてコードを貼り付ける
- **Alt + F11** でVBE（コードを書く画面）を開く
- メニュー「**挿入**」→「**標準モジュール**」
- 下の「コード（最小版）」または「コード（実務版）」をコピーしてコードウィンドウに貼り付ける
一般的にはAlt + F11で開けるが、企業のセキュリティ設定でVBAが無効化されている場合は、IT部門に確認すること。ボタンからワンクリックで実行したい場合は マクロをボタン1つで実行する方法 を参照。
ステップ3：パスを書き換える
コード内の basePath（振り分け先の親フォルダ）と srcPath（元フォルダ）を、自分のフォルダパスに書き換える。
パスの末尾に \ を忘れないこと。
パスの確認方法：エクスプローラーでフォルダを開き、アドレスバーをクリックするとパスが表示される。それをコピーして使う。
ステップ4：マクロを実行する
- **Alt + F8** を押す
- マクロ名を選択して「実行」
- 確認ダイアログが表示されるので内容を確認して「はい」を押す（実務版）
ステップ5：結果を確認する
- 振り分け先フォルダが正しく作成されているか確認する
- ファイルが正しいフォルダに移動しているか確認する
- C列のログに「振り分け先なし」のファイルがないか確認する（実務版）
- 振り分け先なしのファイルが元フォルダに残っているか確認する
コード（最小版）– MkDirでフォルダ1つ作成＋Nameでファイル1つ移動
まずはこれだけで動く。VBA標準の MkDir でフォルダを1つ作成し、Name 文でファイルを1つ移動する。参照設定は不要。
'============================================================
' ■ フォルダを1つ作成してファイルを1つ移動（最小版）
' → MkDir でフォルダ作成
' → Name 文でファイル移動
' → 参照設定不要。VBA標準関数のみ
'============================================================
Sub CreateFolderAndMoveFile()
'--- ★書き換えポイント ---
Dim basePath As String
basePath = "C:\Users\（ユーザー名）\Desktop\振り分け先\" '← 振り分け先の親フォルダ
Dim folderName As String
folderName = "売上報告" '← 作成するフォルダ名
Dim srcPath As String
srcPath = "C:\Users\（ユーザー名）\Desktop\作業フォルダ\" '← 元フォルダ
Dim fileName As String
fileName = "売上_202601.xlsx" '← 移動するファイル名
'--- ★ここまで ---
'--- フォルダの存在チェック → なければ作成
If Dir(basePath & folderName, vbDirectory) = "" Then
MkDir basePath & folderName
MsgBox "フォルダを作成しました：" & basePath & folderName, vbInformation
Else
MsgBox "フォルダは既に存在します：" & basePath & folderName, vbInformation
End If
'--- 元ファイルの存在チェック
If Dir(srcPath & fileName) = "" Then
MsgBox "ファイルが見つかりません：" & srcPath & fileName, vbExclamation
Exit Sub
End If
'--- 移動先に同名ファイルがないかチェック
If Dir(basePath & folderName & "\" & fileName) <> "" Then
MsgBox "移動先に同名ファイルが既に存在します：" & _
basePath & folderName & "\" & fileName, vbExclamation
Exit Sub
End If
'--- ファイルを移動（Name 旧パス As 新パス）
Name srcPath & fileName As basePath & folderName & "\" & fileName
MsgBox "ファイルを移動しました：" & vbCrLf & _
srcPath & fileName & vbCrLf & _
"→ " & basePath & folderName & "\" & fileName, vbInformation
End Sub書き換えポイント
| 変数 | 説明 | 初期値 |
|---|---|---|
| `basePath` | 振り分け先の親フォルダ（末尾に `\`） | `”C:\Users\（ユーザー名）\Desktop\振り分け先\”` |
| `folderName` | 作成するフォルダ名 | `”売上報告”` |
| `srcPath` | 元ファイルがあるフォルダ（末尾に `\`） | `”C:\Users\（ユーザー名）\Desktop\作業フォルダ\”` |
| `fileName` | 移動するファイル名（拡張子を含む） | `”売上_202601.xlsx”` |
コードの流れ
- **Dir() でフォルダ存在確認**: `Dir(パス, vbDirectory)` が空文字なら存在しない → `MkDir` で作成
- **Dir() で元ファイル存在確認**: ファイルがなければエラーメッセージを出して終了
- **Dir() で移動先の同名チェック**: 移動先に同じ名前のファイルがあれば警告して終了
- **Name 文でファイル移動**: `Name 旧パス As 新パス` で元フォルダから振り分け先フォルダにファイルを移動
ポイント:
- `MkDir` はVBA標準の関数。参照設定は不要でそのままコピペで動く
- `MkDir` で既に存在するフォルダと同名のフォルダを作ると **実行時エラー ’75’** になる。必ず `Dir()` で存在チェックしてから作成する
- `Name` 文で移動すると、元フォルダからファイルがなくなる。コピーして残したい場合は `Name` の行を `FileCopy srcPath & fileName, basePath & folderName & “\” & fileName` に変える。コピーの詳細は [ファイルを別フォルダにコピー・移動する方法](/003) を参照
- 移動ではなくコピーで振り分けたい場合の詳細は [ファイルを別フォルダにコピー・移動する方法](/003) を参照
コード（実務版）– セル一覧からフォルダ一括作成＋キーワード振り分け＋ログ
複数のフォルダを一括作成し、ファイル名のキーワードで自動振り分けする場合はこちら。Sheet1のA列（フォルダ名）、B列（キーワード）に従って処理し、C列にログを記録する。
以前、手動で月別フォルダを12個作り、100個のファイルを1つずつ振り分けていた。フォルダ名を打ち間違えて「2月」と「2月 」（末尾に半角スペース）の2つができたり、違うフォルダにファイルを入れて気づかなかったりした。このコードを使い始めてからは、セルの一覧に打ち込んで実行するだけなので、打ち間違いもファイルの入れ間違いもゼロになった。
'============================================================
' ■ セル一覧からフォルダ一括作成＋キーワード振り分け＋ログ（実務版）
' → Sheet1のA列:フォルダ名、B列:キーワード
' → basePath配下にフォルダを一括作成
' → srcPath内のファイル名にキーワードが含まれれば該当フォルダへ移動
' → C列にログ記録
' → 確認ダイアログ付き
'============================================================
Sub CreateFoldersAndSortFiles()
'--- ★書き換えポイント ---
Dim basePath As String
basePath = "C:\Users\（ユーザー名）\Desktop\振り分け先\" '← 振り分け先の親フォルダ
Dim srcPath As String
srcPath = "C:\Users\（ユーザー名）\Desktop\作業フォルダ\" '← 元フォルダ
Dim wsName As String
wsName = "Sheet1" '← 設定シート名
'--- ★ここまで ---
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets(wsName)
'--- 最終行を取得（A列基準）
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
If lastRow < 2 Then
MsgBox "A列にフォルダ名が入力されていません。" & vbCrLf & _
"A2以降にフォルダ名を入力してください。", vbExclamation
Set fso = Nothing
Exit Sub
End If
'--- 元フォルダの存在チェック
If Not fso.FolderExists(srcPath) Then
MsgBox "元フォルダが見つかりません：" & srcPath, vbExclamation
Set fso = Nothing
Exit Sub
End If
'--- 振り分け先の親フォルダの存在チェック
If Not fso.FolderExists(basePath) Then
MsgBox "振り分け先の親フォルダが見つかりません：" & basePath, vbExclamation
Set fso = Nothing
Exit Sub
End If
'--- 確認ダイアログ
Dim msg As String
msg = "以下の設定でフォルダ作成＋ファイル振り分けを実行します。" & vbCrLf & vbCrLf & _
"振り分け先：" & basePath & vbCrLf & _
"元フォルダ：" & srcPath & vbCrLf & _
"フォルダ数：" & (lastRow - 1) & " 件" & vbCrLf & vbCrLf & _
"【注意】ファイル移動は元フォルダからファイルがなくなる操作です。" & vbCrLf & _
"バックアップは取りましたか？" & vbCrLf & vbCrLf & _
"実行しますか？"
If MsgBox(msg, vbYesNo + vbExclamation) = vbNo Then
Set fso = Nothing
Exit Sub
End If
'--- C列（ログ列）をクリア
ws.Range("C:C").Clear
ws.Cells(1, 3).Value = "ログ"
Dim folderCreateCount As Long
Dim moveSuccessCount As Long
Dim moveFailCount As Long
Dim noMatchCount As Long
'--- STEP1：フォルダを一括作成
Dim i As Long
Dim folderFullPath As String
For i = 2 To lastRow
If ws.Cells(i, 1).Value <> "" Then
folderFullPath = basePath & ws.Cells(i, 1).Value
If Not fso.FolderExists(folderFullPath) Then
fso.CreateFolder folderFullPath
ws.Cells(i, 3).Value = "フォルダ作成済み"
folderCreateCount = folderCreateCount + 1
Else
ws.Cells(i, 3).Value = "フォルダ既存（スキップ）"
End If
End If
Next i
'--- STEP2：元フォルダ内のファイルをキーワードで振り分け
Dim srcFolder As Object
Set srcFolder = fso.GetFolder(srcPath)
Dim file As Object
Dim matched As Boolean
Dim targetFolder As String
Dim logText As String
For Each file In srcFolder.Files
matched = False
'--- A列のキーワード（B列）と照合（上から順に判定）
For i = 2 To lastRow
Dim keyword As String
keyword = ws.Cells(i, 2).Value
If keyword <> "" Then
'--- ファイル名にキーワードが含まれるか判定
If InStr(1, file.Name, keyword, vbTextCompare) > 0 Then
targetFolder = basePath & ws.Cells(i, 1).Value & "\"
'--- 移動先に同名ファイルがないかチェック
If fso.FileExists(targetFolder & file.Name) Then
logText = file.Name & " → 失敗：移動先に同名ファイルが存在"
ws.Cells(i, 3).Value = ws.Cells(i, 3).Value & _
IIf(ws.Cells(i, 3).Value <> "" And _
Right(ws.Cells(i, 3).Value, 1) <> vbLf, _
" / ", "") & logText
moveFailCount = moveFailCount + 1
matched = True
Exit For
End If
'--- ファイルを移動
On Error Resume Next
fso.MoveFile file.Path, targetFolder & file.Name
If Err.Number = 0 Then
logText = file.Name & " → 移動成功"
moveSuccessCount = moveSuccessCount + 1
Else
logText = file.Name & " → 失敗：" & Err.Description
moveFailCount = moveFailCount + 1
Err.Clear
End If
On Error GoTo 0
'--- C列にログを追記
ws.Cells(i, 3).Value = ws.Cells(i, 3).Value & _
IIf(ws.Cells(i, 3).Value <> "" And _
Right(ws.Cells(i, 3).Value, 1) <> vbLf, _
" / ", "") & logText
matched = True
Exit For '← 最初に一致したフォルダに振り分け（上から順に判定）
End If
End If
Next i
'--- どのキーワードにも一致しなかった場合
If Not matched Then
noMatchCount = noMatchCount + 1
End If
Next file
Set fso = Nothing
'--- 完了メッセージ
MsgBox "完了しました。" & vbCrLf & vbCrLf & _
"フォルダ作成：" & folderCreateCount & " 件" & vbCrLf & _
"移動成功：" & moveSuccessCount & " 件" & vbCrLf & _
"移動失敗：" & moveFailCount & " 件" & vbCrLf & _
"振り分け先なし：" & noMatchCount & " 件" & vbCrLf & vbCrLf & _
"C列にログを記録しました。", vbInformation
End Sub書き換えポイント
| 変数 | 説明 | 初期値 |
|---|---|---|
| `basePath` | 振り分け先の親フォルダ（末尾に `\`） | `”C:\Users\（ユーザー名）\Desktop\振り分け先\”` |
| `srcPath` | 元ファイルがあるフォルダ（末尾に `\`） | `”C:\Users\（ユーザー名）\Desktop\作業フォルダ\”` |
| `wsName` | フォルダ名・キーワードを入力したシート名 | `”Sheet1″` |
コードの流れ
- **CreateObject(“Scripting.FileSystemObject”)**: FileSystemObjectを作成（参照設定不要）
- **最終行の取得**: A列のデータ数からフォルダの件数を自動検出する
- **存在チェック**: 元フォルダと振り分け先の親フォルダが存在するか確認する
- **確認ダイアログ**: フォルダ数と注意事項を表示し、実行してよいか確認する
- **STEP1 フォルダ一括作成**: A列のフォルダ名を順に読み取り、`fso.FolderExists` で存在チェック → なければ `fso.CreateFolder` で作成
- **STEP2 ファイル振り分け**: 元フォルダ内の各ファイルについて、B列のキーワードが含まれるかを `InStr` で判定 → 一致すれば `fso.MoveFile` で移動
- **ログ記録**: C列に「フォルダ作成済み」「移動成功」「失敗：理由」を記録
- **完了メッセージ**: フォルダ作成数・移動成功数・失敗数・振り分け先なし数をMsgBoxで表示
ポイント:
- キーワードの照合は **上から順に判定** され、最初に一致したフォルダに振り分けられる。より具体的なキーワードを上の行に配置すること
- `InStr` の第4引数に `vbTextCompare` を指定しているため、大文字・小文字を区別しない
- キーワードが空欄のフォルダはフォルダ作成のみ行い、振り分け対象にはならない
- どのキーワードにも一致しなかったファイルは元フォルダにそのまま残る
- エラー処理は `On Error Resume Next` でファイル単位のエラーを捕捉し、次のファイルに進む。エラー処理の詳細は [エラー処理で止まらないマクロを作る方法](/022) を参照
よくある落とし穴5選
1. MkDirで「実行時エラー ’75’: パス名が無効です」
原因: MkDir で既に存在するフォルダと同名のフォルダを作成しようとした。
対策: 必ず Dir(パス, vbDirectory) または fso.FolderExists で存在確認してから作成する。最小版・実務版ともにこのチェックを組み込んでいる。
2. パス末尾の `\` 忘れで「パスが見つかりません」
原因: basePath や srcPath の末尾に \ がない。Name "C:\FolderA売上.xlsx" As ... のように、フォルダ名とファイル名が連結されてしまう。
対策: パスの末尾に \ を必ず付ける。エクスプローラーからコピーしたパスには \ が付いていないことがあるので、貼り付けた後に確認すること。
3. 移動先に同名ファイルがあるとエラーで止まる
原因: Name 文も fso.MoveFile も、移動先に同名ファイルが存在するとエラーになる。上書きはしない。
対策: 実務版では移動前に fso.FileExists で同名チェックを行い、存在する場合はスキップしてログに記録する。最小版でも Dir() で同名チェックを行っている。
4. キーワードが複数のフォルダに一致する
原因: 「売上」キーワードが「売上報告」フォルダと「月次売上」フォルダの両方のB列に設定されていた場合、Sheet1の上の行が優先される。
対策: 振り分けルールは上から順に判定される。より具体的なキーワード（例：「売上報告」）を上の行に、広いキーワード（例：「売上」）を下の行に配置する。
5. サブフォルダ内のファイルは振り分けられない
原因: この記事のコードは、元フォルダの直下にあるファイルのみ対象。サブフォルダの中のファイルは振り分けの対象外。
対策: サブフォルダも含めて振り分けたい場合は、再帰処理（フォルダの中のフォルダを順にたどる処理）が必要になる。この記事の範囲外のため、必要な場合はココナラで相談可。
FAQ
Q1: フォルダが既に存在する場合はどうなる？
最小版では Dir() で存在チェックし、存在する場合はスキップする（MsgBoxで通知）。実務版でも fso.FolderExists で確認してから作成するので、既存フォルダは上書きされない。C列に「フォルダ既存（スキップ）」と記録される。
Q2: ファイルを移動ではなくコピーで振り分けたい（元を残したい）
最小版では Name 文の行を FileCopy 文に変える。実務版では fso.MoveFile を fso.CopyFile に変更する。コピーの詳細は ファイルを別フォルダにコピー・移動する方法 を参照。
Q3: 拡張子ごとにフォルダを振り分けたい（.xlsxはフォルダA、.pdfはフォルダBなど）
B列のキーワードに .xlsx .pdf と入力すれば、拡張子での振り分けもできる。ただしファイル名にも「xlsx」という文字列が含まれている場合は意図しない振り分けになるため、拡張子の .（ドット）を含めて .xlsx のように指定すること。より高度な振り分け（拡張子の厳密な判定）が必要な場合はココナラで相談可。
Q4: 振り分け先が見つからないファイルはどうなる？
元フォルダにそのまま残る。移動も削除もされない。実務版では完了メッセージに「振り分け先なし：○件」と表示されるので、件数が想定と合っているか確認すること。
Q5: ネットワークドライブ（\server\share）でも使える？
一般的にはUNCパス（\\サーバー名\共有名\）でも動作する。ただしアクセス権限が必要。共有フォルダのファイルを移動する場合は、他の利用者に事前確認すること。ネットワーク遅延で処理に時間がかかる場合がある。
まとめ
この記事で、VBAを使ったフォルダの自動作成とファイルの振り分けができるようになった。
- **最小版**: `MkDir` でフォルダ1つ作成 + `Name` 文でファイル1つ移動
- **実務版**: Sheet1のセル一覧からフォルダを一括作成 + ファイル名のキーワードで自動振り分け + C列にログ記録
重要：ファイル移動は元フォルダからファイルがなくなる操作。必ずバックアップを取ってから実行すること。
関連記事
- 元フォルダのファイル名を一覧で確認したい場合は [フォルダ内のファイル一覧をExcelに自動出力する方法](/001) を参照
- 振り分け後にファイル名を変えたい場合は [ファイル名を一括変更（リネーム）する方法](/002) を参照
- ファイルのコピー・移動の基本は [ファイルを別フォルダにコピー・移動する方法](/003) を参照
次にやりたくなること
- **[古いファイルを自動削除する方法](/004)**: 振り分け後に不要になった古いファイルを自動で整理したい場合に便利
- **[フォルダ内のファイル一覧をExcelに自動出力する方法](/001)**: 振り分け前に元フォルダのファイル名を確認したい場合に使える
もっとカスタマイズしたい場合
「拡張子ごとに振り分けルールを変えたい」「サブフォルダの中身も含めたい」「定期実行したい」「日付ごとにフォルダを自動作成したい」など、業務に合わせたカスタマイズが必要な場合は、ココナラで相談できます。
相談時に以下の情報があるとスムーズです：
- Excel のバージョン / OS
- 元フォルダ・振り分け先フォルダの構成
- 振り分けのルール（例：キーワード、拡張子、日付、担当者名）
- ファイルの数（目安）
- サブフォルダを含めるかどうか
コメント