
日常業務を行うにあたって、定例作業で大量のフォルダを作成することがあるかと思います。
その際に以下の操作を繰り返していないでしょうか。
- 作りたいフォルダ階層に移動してフォルダを作成する。
- フォルダ名称を変更する。
- 作ったフォルダの中の階層に再度移動してフォルダを作成する。
- フォルダ名を変更する。
上記の作業を、例えばフォルダを100個作りたいのなら100回繰り返す。さらに毎月定例作業として行う必要がある。
定例の作業を自分の時間を削って、何度も何度も繰り返し行っていては、時間が非常にもったいないです。
そんな場面で、無駄な作業が効率化できる、フォルダ階層を指定して一度に大量のフォルダを一括作成する『複数フォルダを階層指定して自動作成できるマクロツール』をExcel VBAで作りました。
当記事にはマクロの元になるExcelファイルがダウンロード可能で、VBAのコードも記事内に記載がありますので、Excel VBAやマクロが良く分からないという方でもすぐに使用できます。
当ツールを使用すれば定例業務の業務効率化が図れるかと思いますので、是非ご活用頂けたらと思います。
このファイル自動作成マクロツールを使用した後に、各フォルダへファイルを振り分ける作業がある場合は、以下の『複数ファイルを振り分けるマクロツール』を使用するとファイルを振り分けることができますので必要に応じて活用頂ければと思います。

・ツールの説明文を1行目に追加、ツールの全体構成の変更、フォルダ名称入力時に同一行をグレーアウトする仕様に変更しました。
・フォルダ作成する際の保存先にフォルダを指定できるように変更しました。
『フォルダ自動作成マクロツール』の概要
当ツールであるExcelファイルの表内(7行目以降)に作成したいフォルダ名を記入し、マクロを実行します。
当ツールが存在しているフォルダ階層(または指定したフォルダ)とそれ以降の階層にそれぞれ指定したフォルダが自動作成されます。
下に説明動画を載せますので、ご確認ください。
<説明動画>
基本的な機能、操作方法の説明
- フォルダ自動作成ツールのマクロが入ったExcelファイル(***.xlsm)をクリックします。

- 表内でフォルダ階層を指定して作成したいフォルダ名称を入力します。
- 「フォルダ作成実行」ボタンをクリックします。

開いているExcelファイルがあるフォルダに指定したフォルダが作成されます。

フォルダの下階層にも指定したフォルダが作成されています。

入力したフォルダ名称とフォルダ構成の関係性

上記表内のとおりフォルダ名称を入力した場合は、以下のようにフォルダが作成されます。
- 当ツールと同階層または指定したフォルダに「フォルダ1」が作成されます。
- 「フォルダ1」の中に「フォルダ2」と「フォルダ3」が作成されます。
- 「フォルダ3」の中に「フォルダ4」が作成されます。
- 「フォルダ4」の中に「フォルダ5」が作成されます。
- 「フォルダ5」の中に「フォルダ6」が作成されます。
- 「フォルダ1」と同階層に「フォルダ7」が作成されます。
- 「フォルダ7」の中に「フォルダ8」が作成されます。
留意事項
当マクロを使用するにあたって、指定するフォルダ名称の記入位置などのルールがありますので、以下を確認してください。
一番最初に指定するフォルダは最上位の階層を指定する
(注意)最初に作成されるフォルダは一番左の列に記入してください。

一つの行に複数のフォルダ名の指定をしない
(注意)1行で記入できるセルは一つだけです。

二つ以上飛ばした下位階層に対してフォルダ名を指定しない
(注意)一つフォルダ名を指定したら、その下の行には「①:一つ右の列 ②:同じ列 ③:左の任意の列」にのみフォルダ名を記入できます

上記のルールを守っていない行は、フォルダ自動作成の対象から外れて処理がスキップされて、赤色で表示させます。
ルールを守った正常な箇所はそのままフォルダ作成処理がされます。

※最初のフォルダが一番左の列を指定していない場合は、エラーメッセージを表示して処理を終了します。
また、実行した結果として、指定したフォルダが全て正常に作成されたか、誤ったフォルダ指定をした箇所が存在するか、どちらかのメッセージが表示されますので確認してください。

使用する際の事前準備
このページの下部にある「Excelファイルのサンプル」からExcelファイルを取得し、「準備の手順」内にあるVBAコードを取得したExcelファイルに記載して保存すれば、すぐに当ツールを使用できます。
以下にその手順を説明していきます。
準備の手順
「サンプルのダウンロードはこちら」からサンプル(Excelファイル)をダウンロードします。
※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています
<手順1>
ダウンロードしたExcelファイルを開いて、VBE(Visual Basic Editor)を起動させます。
- Excelファイルの上部にあるリボンの「開発」タブを選択します。
- 「Visual Basic」をクリックして、VBE(Visual Basic Editor)を起動させます。

<手順2>
- 「ThisWorkbook」をダブルクリックします。

<手順3>
- 表示されている右側の欄(エディター)に以下のVBAコードを記載します。

VBAのソースコードはこちら
以下のVBAコードをコピーして、「ThisWorkbook」内のエディターに貼り付けます。
Option Explicit
'-----(設定値)------------------------
Private Const HEAD_ROW = 6 '1.テーブル見出し行の行番号
Private Const HEAD_COL_NUM = 2 '2.テーブル見出し行の最初の列番号
Private Const HEAD_END_COL_NUM = 6 '3.テーブル見出し行の最終列の列番号
Private Const PATH_DELIMITER = "/" '4.パスの区切り文字
'-----(メッセージ)-------------------
Private Const Msg1 = "フォルダ作成処理が正常に実行されました"
Private Const Msg2 = "作成したフォルダを保存する先のフォルダを指定して下さい。"
Private Const WMsg1 = "赤色で表示された箇所はフォルダ作成されていません"
Private Const WMsg2 = "最初のフォルダで最上位階層を指定してください。"
Private Const EMsg1 = "予期せぬエラーが発生しました"
'---------------------------------------
Private LngErrRow() As String 'エラーが発生した行数
'===========================================
'フォルダ作成(ツールと同階層)を実行した際の処理
'===========================================
Sub フォルダ作成実行_click()
On Error GoTo err
ActiveSheet.Shapes(Application.Caller).Visible = False 'ボタンを非表示にして押し込む動作をつける
Application.ScreenUpdating = True
Call initialize
Call errCheck
Call makeFolder(ThisWorkbook.Path)
If LngErrRow(0) <> "" Then
MsgBox WMsg1
Else
MsgBox Msg1
End If
ActiveSheet.Shapes(Application.Caller).Visible = True
Exit Sub
err:
MsgBox EMsg1, vbOKOnly + vbCritical
ActiveSheet.Shapes(Application.Caller).Visible = True
End Sub
'===========================================
'フォルダ作成(フォルダ選択ダイアログから選択)を実行した際の処理
'===========================================
Sub 作成先を指定してフォルダ作成実行_click()
On Error GoTo err
ActiveSheet.Shapes(Application.Caller).Visible = False 'ボタンを非表示にして押し込む動作をつける
Application.ScreenUpdating = True
Call initialize
Call errCheck
Dim importDir As String '指定したフォルダ名
'フォルダ選択ダイアログを表示させる
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = Msg2
If .Show <> 0 Then
importDir = .SelectedItems(1)
Else
GoTo lastProcess
End If
End With
Call makeFolder(importDir)
If LngErrRow(0) <> "" Then
MsgBox WMsg1
Else
MsgBox Msg1
End If
lastProcess:
ActiveSheet.Shapes(Application.Caller).Visible = True
Exit Sub
err:
MsgBox EMsg1, vbOKOnly + vbCritical
ActiveSheet.Shapes(Application.Caller).Visible = True
End Sub
'-------------------------------------
'色の変更、作業行の初期化等を行う
'-------------------------------------
Sub initialize()
Dim iRow As Long
'表の最終行番号を取得する
iRow = Cells(HEAD_ROW, HEAD_COL_NUM).SpecialCells(xlCellTypeLastCell).row
'表全体の文字色を黒色に変更する
Range(Cells(HEAD_ROW + 1, HEAD_COL_NUM), Cells(iRow, HEAD_END_COL_NUM)).Font.ColorIndex = 1
ReDim LngErrRow(0)
End Sub
'-----------------------------------------------------------------
'本来のフォルダ構成になっていない行数があった場合エラー処理をする
'-----------------------------------------------------------------
Sub errCheck()
Dim row As Long
Dim col As Long
Dim arrNum As Long '配列の番号
Dim baseColNum As Long: baseColNum = 0 'フォルダ名称が記載されている比較対象の列番号
Dim fColNum As Long 'フォルダ名称が記載されている列番号
'最初の行で一番左の列に値が入っていない場合は処理を終了する
If Cells(HEAD_ROW + 1, HEAD_COL_NUM) = "" Then
MsgBox WMsg2
Call errHandling(arrNum, HEAD_ROW + 1)
ActiveSheet.Shapes(Application.Caller).Visible = True
End
End If
'フォルダ名称が記載されている行数分だけ繰り返す
For row = HEAD_ROW + 1 To Cells(HEAD_ROW, HEAD_COL_NUM).SpecialCells(xlCellTypeLastCell).row
'同一行数に複数データが存在する場合はエラーとする
If WorksheetFunction.CountA(Range(row & ":" & row)) > 1 Then
Call errHandling(arrNum, row)
GoTo continue
'同一行数に値が一つだけある場合は別のエラーチェックをする
ElseIf WorksheetFunction.CountA(Range(row & ":" & row)) = 1 Then
'フォルダ名称が記載されている列数分だけ繰り返す
For col = HEAD_COL_NUM To HEAD_END_COL_NUM
'対象セルに値が存在した場合
If Cells(row, col) <> "" Then
fColNum = col
Exit For
End If
Next col
'想定されていない箇所にフォルダ名称がある場合はエラーとする
If (baseColNum = 1 And (fColNum = 3 Or fColNum = 4 Or fColNum = 5)) Or _
(baseColNum = 2 And (fColNum = 4 Or fColNum = 5)) Or _
(baseColNum = 3 And fColNum = 5) Then
Call errHandling(arrNum, row)
GoTo continue
Else
'フォルダ名が記載された位置に問題なければ、比較元の列番号を変更する
baseColNum = fColNum
End If
End If
continue:
Next row
End Sub
'---------------------------------------------------
'記載されている通りの構成と名称でフォルダを作成する
'---------------------------------------------------
Sub makeFolder(folderPath As String)
Dim row As Long
Dim col As Long
Dim layerNm1 As String
Dim layerNm2 As String
Dim layerNm3 As String
Dim layerNm4 As String
Dim layerNm5 As String
Dim fPath As String
Dim fName As String
'フォルダ名称が記載されている行数分だけ繰り返す
For row = HEAD_ROW + 1 To Cells(HEAD_ROW, HEAD_COL_NUM).SpecialCells(xlCellTypeLastCell).row
'エラー対象の行はフォルダ作成処理から外す
If UBound(Filter(LngErrRow, CStr(row))) <> -1 Then
GoTo continue
End If
'フォルダ名称が記載されている列数分だけ繰り返す
For col = HEAD_COL_NUM To HEAD_END_COL_NUM
If Cells(row, col) <> "" Then
Select Case col
Case HEAD_COL_NUM
layerNm1 = Cells(row, col)
fPath = ""
Case HEAD_COL_NUM + 1
layerNm2 = Cells(row, col)
fPath = PATH_DELIMITER & layerNm1
Case HEAD_COL_NUM + 2
layerNm3 = Cells(row, col)
fPath = PATH_DELIMITER & layerNm1 & PATH_DELIMITER & layerNm2
Case HEAD_COL_NUM + 3
layerNm4 = Cells(row, col)
fPath = PATH_DELIMITER & layerNm1 & PATH_DELIMITER & layerNm2 & PATH_DELIMITER & layerNm3
Case HEAD_COL_NUM + 4
layerNm5 = Cells(row, col)
fPath = PATH_DELIMITER & layerNm1 & PATH_DELIMITER & layerNm2 & PATH_DELIMITER & layerNm3 & PATH_DELIMITER & layerNm4
End Select
fName = Cells(row, col)
Exit For
End If
Next col
'指定されたフォルダ構成と名称のフォルダが既に存在していたらフォルダ作成を行わない
If Dir(folderPath & fPath & PATH_DELIMITER & fName, vbDirectory) = "" Then
'フォルダ作成処理
MkDir folderPath & fPath & PATH_DELIMITER & fName
End If
continue:
Next row
End Sub
'-----------------------------------------------------------
'エラーがあった行は赤色表示にして、フォルダ作成対象から外す
'-----------------------------------------------------------
Sub errHandling(arrNum As Long, errRow As Long)
ReDim Preserve LngErrRow(arrNum)
LngErrRow(arrNum) = CStr(errRow)
'文字色を赤色に変更する
Rows(errRow).Font.ColorIndex = 3
arrNum = arrNum + 1
End Sub
'===========================================
'当ファイルのエクセル内の値を変更した後に実行する処理
'===========================================
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim i, iCol, iRow As Long
Dim selSRow, selERow As Long
Dim existFlg As Boolean
selSRow = Range(Selection.Rows(1).Address).row
selERow = Range(Selection.Rows(Selection.Rows.Count).Address).row
iCol = Target.Column
iRow = Target.row
If selSRow = selERow Then
selSRow = iRow
selERow = iRow
End If
'選択範囲が表内であれば色を変える処理をする
If iRow >= HEAD_ROW + 1 And iCol <= HEAD_END_COL_NUM Then
For iRow = selSRow To selERow
For i = HEAD_COL_NUM To HEAD_END_COL_NUM
If ActiveSheet.Cells(iRow, i).Value <> "" Then
ActiveSheet.Cells(iRow, i).Interior.Color = RGB(255, 255, 255)
existFlg = True
Else
ActiveSheet.Cells(iRow, i).Interior.Color = RGB(220, 220, 220)
End If
Next
If existFlg = False Then
ActiveSheet.Range(Cells(iRow, HEAD_COL_NUM), Cells(iRow, HEAD_END_COL_NUM)).Interior.Color = RGB(255, 255, 255)
End If
existFlg = False
Next
End If
End Sub
<手順4>
マクロを含んだExcelとして、ファイルを保存します。
- 左上にある「保存」アイコンをクリックします。
- 「ファイルの種類」から「Excelマクロ有効ブック」を選択します。
- 「保存」をクリックします。

<手順5>
「フォルダ作成実行」ボタンにメイン処理「フォルダ作成実行_Click」のマクロを設定します。
- 「フォルダ作成実行」ボタンを右クリックします。
- 「マクロの登録」をクリックします。
- 「Thisworkbook.フォルダ作成実行_Click」を選択します。
- 「OK」をクリックします。

「フォルダ自動作成実行」にカーソルを当てて、指の形になっているのを確認します。
<手順6>
「作成先を指定してフォルダ作成実行」ボタンにメイン処理「作成先を指定してフォルダ作成実行_Click」のマクロを設定します。
- 「作成先を指定してフォルダ作成実行」ボタンを右クリックします。
- 「マクロの登録」をクリックします。
- 「Thisworkbook.作成先を指定してフォルダ作成実行_Click」を選択します。
- 「OK」をクリックします。

もう一つのボタンと同様に「作成先を指定してフォルダ自動作成実行」にカーソルを当てて、指の形になっているのを確認します。
これで事前準備は完了です。
あとは「当ツールの使用方法」で記載された方法でツールを実行できます。
なお、当マクロの開発環境は、OS:Windows10 、Excelのバージョン:Microsoft Office 365となっており、当環境では動作確認ができていますが、他の環境で正常に動作するかは確認できていません。
正常に動作しない場合は、コメントいただければ幸いです。
また以下にて、このような業務効率化できるツールを機能ごとの一覧でまとめてますので、ご興味のある方はご覧ください。
自力で業務効率化できるツール等を作成する場合は、「オンラインITスクール」を利用するとモチベーションを保ちつつ、効率的に学習とアウトプットができると思います。

自分に合わないと感じた場合は返金してもらえるため、ノーリスクで試すことができます。是非一度体験してみることをオススメします ^ ^
当ツールのダウンロードはこちら
下記よりExcelファイルをダウンロードして、記事の途中にありました VBAのソースコードをツール内に組み込んで使用してください。
【Excel VBA】フォルダ自動作成ツール
※インターネットにあるマクロファイルをダウンロードすることはセキュリティ上リスクがあるので、マクロ無しExcelファイルを公開しています
他に要望等ありましたら、可能な限り改修等を対応しますのでコメント頂ければと思います。
<このツールが『結構使える!』と思ったら、下のグッドボタンを押していただけたら幸いです>
お知恵を拝借させていただきました。ありがとうございました。
膨大な時間がかかる筈だった業務の、大幅な時間短縮を図ることができました。
生成したフォルダに、PDFファイルを格納していきたいのですが
リスト化したものを(このファイル名はこのフォルダに格納する、という情報が記載されているもの)用いて、マクロを組むことはできるのでしょうか。
当方、自粛期間中にマクロを習得しましたがまだまだ経験不足のため
お力をお貸しいただけますと幸いです。
不躾なご依頼誠に恐縮ですが、どうぞご検討のほどよろしくお願いいたします。
管理人のRHです。
村上様、閲覧頂きまして、ありがとうございます。
完璧ではないかもしれませんが、実現したい機能のイメージは伝わりました。
マクロで実現可能だと思いますが、このコメント欄で全て説明するのは、とても大変そうです。
そのため、遠くない先、次の業務効率化ツールを作成する際は村上様のイメージされている機能を満たしたマクロを作成しようと思います。
こちらのマクロを使って一括で階層化されたフォルダを作成することができました。
ありがとうございます!
一点問題を見つけたので報告させていただきたいと思います。
▼環境
Windows10
Excel2019
▼問題
6列目以降にフォルダ名を記載して階層を指定していると、6列目以降のフォルダ作成が無視されてしまう。
例えば以下のように指定すると、Voice、SE、BGMといったフォルダが作成されないようでした。
——————————————–
Content
Main
Common
Texture
Animation
Media
Audio
Voice
SE
BGM
Video
——————————————–
管理人のRHです。
当ツールをお使い頂き、また併せて問題をご報告いただき、ありがとうございます。
ご指摘の件ですが、
当ツールの設計としては、6列目以降の文字はフォルダ作成の対象外となるような作りになっています。
開発するにあたり固定された数分(今回は5列分)でしかアルゴリズムが思いつかず、6列以上のフォルダ作成に至りませんでした。(力不足ですみません。)
使いたい等のご要望がありましたら、頑張って考えますので、改めてお教えください。
テキスト内容をコピーして実行してみたのですが、デバックが発生し実行できませんでした。
マクロ勉強し始めたばかりですので、解決していただけますでしょうか?
以下にてデバック発生しました。
‘指定されたフォルダ構成と名称のフォルダが既に存在していたらフォルダ作成を行わない
If Dir(ThisWorkbook.Path & fPath & “\” & fName, vbDirectory) = “” Then
個人のPCはwindows10
office2019です。
宜しく御願いいたします。
管理人のRHです。
当ツールをお使い頂き、また併せて問題をご報告いただき、ありがとうございます。
以下のコードでエラーが発生して、マクロが正常に動作しなかったとのことですが、デバッグ時のエラー内容は分かりますでしょうか。可能でしたらエラーコード番号とエラーの内容が分かれば原因究明しやすいかと思います。
例えば、「エラーコード:76」「エラー内容:パスが見つかりません。」など教えていただければ幸いです。
>‘指定されたフォルダ構成と名称のフォルダが既に存在していたらフォルダ作成を行わない
>If Dir(ThisWorkbook.Path & fPath & “\” & fName, vbDirectory) = “” Then
考えられるエラーの可能性としては、「1.フォルダパスが長すぎる。」「2.フォルダ作成しようとしている場所がネットワークドライブ等で特殊な場所」などかと思います。
その場合は、試しにデスクトップ(Cドライブ)などに当該VBAファイルを置いて実行してみるとどうなるかご確認いただければと思います。
ご回答ありがとうございます。
エラー内容について共有します。
「実行時エラー’52’ファイル名または番号が不正です。」とエラー表示されています。
デスクトップ直下で試してみたのですが同じ結果でした。
たびたび、申し訳ないのですが問題を判断できる場合ご教示いただけますと幸いです。
私も勉強としていろいろ試行錯誤してみようと思います…
一度返信してしまったのですが、解決できました。
解決した内容ですが、ThisWorkbook.Pathがone dirveの影響でエラー吐き出したようです。
one driveの同期を解除した際に、マクロが正常に動きフォルダ作成致しました!
ありがとうございました!
管理人のRHです。
ご連絡いただき、ありがとうございます。
なるほどですね、one driveと同期していることで当該マクロのパスがone drive先を見にいっていた等で悪影響を及ぼしていたのですね。
そのような挙動になることは知りませんでした。
>ThisWorkbook.Pathがone dirveの影響でエラー吐き出したようです。
IT素人様の環境で動作したということで、良かったです。
お世話になります。MAC上でこのプログラム使わせていただきました。
一つ注意点がありましたので、お知らせします。
MACの場合は、このままコピペすると「実行時エラー ’76’ パスが見つかりません」で実行できません。
\ となってるところを / に変更したら正常に実行できました。
MACでも活用させていただきます。ありがとうございました!
管理人のRHです。
Emiさん、ツールをお使いいただき、ありがとうございます。
そうなのですね、失礼しました。
MACでの動作は確認しておりませんでした。
貴重なご意見ありがとうございます。今後の改修等に役立たせていただきます。
他のツールもありますので、是非ご活用ください。
RHさま
その節はお世話になりました。
作成先を指定してフォルダ作成実行のボタンを押すと作成したフォルダを保存する先のフォルダを指定して下さい。となりフォルダを選択する形になります。これを別ソフトにある「【知らなくても使える】複数ファイルを指定したフォルダに自動で振り分けるマクロツール」と同じように振り分けフォルダパスの項目を作成して頂けないでしょうか。宜しくお願い致します。
管理人のRHです。
KOZIさん、コメントありがとうございます。
当ツールでも、振り分けフォルダパスの値を表示させることは可能です。
こちらも対応しますので、もう少々お待ちください。