エクセルマクロで、フォルダを作成するVBAコードを記載しています。
このページのマクロコードは、コピペで使えます。
ぜひお試しください😉
フォルダを作成
以下のマクロを実行すると、指定場所にフォルダを作成します。
Sub フォルダを作成()
Dim MyPath As String
MyPath = "C:\Users\admin\Desktop\テスト\リストA"
If Dir(MyPath, vbDirectory) = "" Then
MkDir MyPath
End If
End Sub
「C:\Users\admin\Desktop\テスト」に「リストA」フォルダを作成します。
IF文で同名ファイルないか判定し、
同名ファイルが存在する場合は、フォルダ作成せず処理を終了します。
フォルダを作成(変数使用)
以下のマクロを実行すると、変数を使用して指定フォルダを作成します。
Sub フォルダを作成()
Dim MyPath As String
Dim MyName As String
MyPath = "C:\Users\admin\Desktop\テスト"
MyName = "リストA"
If Dir(MyPath & "\" & MyName, vbDirectory) = "" Then
MkDir MyPath & "\" & MyName
End If
End Sub
「C:\Users\admin\Desktop\テスト」に「リストA」フォルダを作成します
フォルダを作成(セル値にパス入力)
以下のマクロを実行すると、セルからフォルダパスを取得してフォルダを作成します。
Sub フォルダを作成()
Dim MyPath As String
MyPath = Range("A1")
If Dir(MyPath, vbDirectory) = "" Then
MkDir MyPath
End If
End Sub
マクロ実行前
[セルA1] にフォルダパスを入力します。
マクロ実行後
「C:\Users\admin\Desktop\テスト」に「リストA」フォルダを作成します。
フォルダを作成(セル値にフォルダ名入力)
以下のマクロを実行すると、セルからフォルダ名を取得してフォルダを作成します。
Sub フォルダを作成()
Dim MyPath As String
Dim Buf As String
Dim i As Long
MyPath = "C:\Users\admin\Desktop\テスト"
For i = 1 To Range("A1").End(xlDown).Row
Buf = MyPath & "\" & Cells(i, 1)
If Dir(Buf, vbDirectory) = "" Then
MkDir Buf
End If
Next i
End Sub
「C:\Users\admin\Desktop\テスト」にフォルダを作成します
フォルダを作成(メインフォルダ・サブフォルダ)
以下のマクロを実行すると、セル値からフォルダ名を取得してフォルダを作成します。
Sub フォルダを作成()
Dim MyPath As String
Dim Buf As String
Dim SubBuf As String
Dim i As Long
Dim j As Long
MyPath = "C:\Users\admin\Desktop\テスト"
'1~最終列までループ
For j = 1 To Range("A1").End(xlToRight).Column
'1~最終行までループ
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If i = 1 Then
Buf = MyPath & "\" & Cells(i, j)
'A列の値と同名のフォルダがなければ処理を進める
If Dir(Buf, vbDirectory) = "" Then
'1列目の値をもとにフォルダ作成
MkDir Buf
Else
Exit For
End If
Else
'2列目以降の値をもとにフォルダ作成
SubBuf = Buf & "\" & Cells(i, j)
MkDir SubBuf
End If
Next i
Next j
End Sub
マクロ実行前
A~C列にフォルダ名にしたい値を入力しておきます。
1列目がメインフォルダ、2列目以降がサブフォルダとします。
マクロ実行後
「C:\Users\admin\Desktop\テスト」にフォルダを作成します
フォルダを作成(メインフォルダ・サブフォルダ・サブサブフォルダ)
以下のマクロを実行すると、表からセル値を取得してメインフォルダ、サブフォルダ、サブサブフォルダを作成します。
Sub フォルダを作成()
Dim MyPath As String
Dim Buf As String
Dim SubBuf As String
Dim SubSubBuf As String
Dim i As Long
'フォルダを作成するパスを指定
MyPath = "C:\Users\admin\Desktop\テスト"
'最終行を取得
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Buf = MyPath & "\" & Cells(i, 1)
'A列の値と同名のフォルダがなければ処理を進める
If Dir(Buf, vbDirectory) = "" Then
'A列の値をもとにフォルダ作成
MkDir Buf
'B列の値をもとにフォルダ作成
SubBuf = Buf & "\" & Cells(i, 2)
MkDir SubBuf
'C列の値をもとにサブフォルダ作成
SubSubBuf = SubBuf & "\" & Cells(i, 3)
MkDir SubSubBuf
End If
Next i
End Sub
マクロ実行前
A~C列にフォルダ名にしたい値を入力しておきます。
A列がメインフォルダ、B列がサブフォルダ、C列がサブサブフォルダとします。
マクロ実行後
「C:\Users\admin\Desktop\テスト」にフォルダを作成します。
2階層以上のフォルダをいっぺんに作成できます。
フォルダを作成(日付)
以下のマクロを実行すると、日付を使ったフォルダを作成します。
Sub フォルダを作成()
Dim MyPath As String
Dim MyDay As String
MyPath = "C:\Users\admin\Desktop\テスト"
MyDay = Format(Date, "yyyymmdd")
If Dir(MyPath & "\" & MyDay, vbDirectory) = "" Then
MkDir MyPath & "\" & MyDay
End If
End Sub
本日の日付のフォルダを作成します。
フォルダを作成(12か月分)
以下のマクロを実行すると、12か月分のフォルダーを作成します。
Sub フォルダを作成()
Dim MyPath As String
Dim MyMonth As String
Dim MyYear As String
Dim Buf As String
Dim i As Long
'フォルダ作成先のパス
MyPath = "C:\Users\admin\Desktop\テスト"
'今年の年を代入
MyYear = "2023"
'1~12月ループ
For i = 1 To 12
'9以下だったら頭に「0」をつける
If i <= 9 Then
MyMonth = CStr(0) & i
Else
MyMonth = i
End If
'パスを連結
Buf = MyPath & "\" & MyYear & MyMonth
'フォルダを作成
If Dir(Buf, vbDirectory) = "" Then
MkDir Buf
End If
Next i
End Sub
12か月分のフォルダを一括作成します。
この記事がお役に立ちますと幸いです。
「Excel自動化[最強]時短仕事術」
自動化の基礎と時短に役立つテクニック解説書
毎日の定型業務を手際良く行え、大幅な業務効率化を実現!