Excel vba フォルダ作成表からフォルダを一括作成

フォルダを毎回一から作成するのは非常に手間…

テンプレートのフォルダを一式用意して、毎回コピペもいいですが

「このフォルダって何用だっけ？」と忘れがちです

フォルダ名やフォルダの概要をExcelで管理して、ボタン一つで

フォルダを作成できるようにしてしまいましょ！

コピペで簡単実装！

できるようになること
・Excelの表からフォルダを一括作成
・フォルダの概要など管理

機能概要
ソースコードの解説
まとめ：Excelの表でフォルダ作成を管理できる

機能概要

Excelのリストからフォルダを作成
出力フォルダを指定
作成するフォルダを選択できる

ソースコードの解説

定数、イベント、関数、順番に解説していきます
急ぎの方は、「全文」からコピペでどうぞ！

定数

対象のセルや列を定数にしています

セルの位置を変更しても、定数化しておくことで
修正を最小限に抑えることができますね

'*****************************************************
' 定数
'*****************************************************

'--フォルダ出力先パス
Const RANGE_FOLDER_PATH As String = "B6"

'--宛先対象文字列セル
Const RANGE_ATTENDANCE As String = "C4"

'--宛先 列範囲
Const RANGE_ATTENDANCE_COLUMN As String = "B:B"

'--メール送信対象区分文字列
Const RANGE_ATTENDANCE_KUBUN As String = "C6"

'--作成 列
Const COLUMN_ATTENDANCE As String = "B"

'--フォルダ名 列
Const COLUMN_FOLDER As String = "C"

'--フォルダ階層区切り
Const SEPARATION As String = "\"

'*****************************************************

' 定数

'*****************************************************

'--フォルダ出力先パス

Const RANGE_FOLDER_PATH As String = "B6"

'--宛先対象文字列セル

Const RANGE_ATTENDANCE As String = "C4"

'--宛先列範囲

Const RANGE_ATTENDANCE_COLUMN As String = "B:B"

'--メール送信対象区分文字列

Const RANGE_ATTENDANCE_KUBUN As String = "C6"

'--作成列

Const COLUMN_ATTENDANCE As String = "B"

'--フォルダ名列

Const COLUMN_FOLDER As String = "C"

'--フォルダ階層区切り

Const SEPARATION As String = "\"

イベント

「作成」ボタンのクリックイベント

'
' 機    能:フォルダ作成ボタンクリック
'
' 機能説明:なし
'
' 引    数:
'
' 返 り 値:
'
' 備  　考:なし
'
Private Sub btnCreateFolder_Click()

   createFolderByExcelList

End Sub

' 機能:フォルダ作成ボタンクリック

' 機能説明:なし

' 引数:

' 返り値:

' 備　考:なし

Private Sub btnCreateFolder_Click()

createFolderByExcelList

End Sub

「出力先を指定する」ボタンのクリックイベント

'
' 機    能:フォルダ出力先指定ボタンクリック
'
' 機能説明:なし
'
' 引    数:
'
' 返 り 値:
'
' 備  　考:なし
'
Private Sub btnSelectOutputPath_Click()

    Dim strOutputPath As String
    
    '現在指定されている出力先を取得
    strOutputPath = Range(RANGE_FOLDER_PATH).Value
    
    'フォルダ選択ダイアログにて、出力先のフォルダパスを取得
    With Application.FileDialog(msoFileDialogFolderPicker)
      .InitialFileName = strOutputPath
        'キャンセルした場合、処理を終了する
        If .Show = 0 Then
        Exit Sub
        Else
            strOutputPath = .SelectedItems(1) + SEPARATION
        End If
    End With
    
    '出力先フォルダパスをExcelに出力
    Range(RANGE_FOLDER_PATH).Value = strOutputPath

End Sub

' 機能:フォルダ出力先指定ボタンクリック

' 機能説明:なし

' 引数:

' 返り値:

' 備　考:なし

Private Sub btnSelectOutputPath_Click()

Dim strOutputPath As String

'現在指定されている出力先を取得

strOutputPath = Range(RANGE_FOLDER_PATH).Value

'フォルダ選択ダイアログにて、出力先のフォルダパスを取得

With Application.FileDialog(msoFileDialogFolderPicker)

.InitialFileName = strOutputPath

'キャンセルした場合、処理を終了する

If .Show = 0 Then

Exit Sub

Else

strOutputPath = .SelectedItems(1) + SEPARATION

End If

End With

'出力先フォルダパスをExcelに出力

Range(RANGE_FOLDER_PATH).Value = strOutputPath

End Sub

関数

表の行数分フォルダ作成関数を実行する

'
' 機    能:フォルダ作成
'
' 機能説明:なし
'
' 引    数:
'
' 返 り 値:
'
' 備  　考:なし
'
Public Function createFolderByExcelList()
    Dim endRowCount As Long
    Dim attendanceStr As String
    Dim attendanceRow As Integer
    
      Dim result As Boolean
    
    '--最終行の取得
    endRowCount = Cells(Rows.Count, COLUMN_FOLDER).End(xlUp).Row
    
    '--開始行の取得
    attendanceRow = getAttendanceRow()
        
    '出力先のフォルダが指定されている場合、フォルダを出力する
    If isOutPutFolder() Then
        For i = attendanceRow To endRowCount
            '--出力対象のフォルダのみ出力
            If Range(RANGE_ATTENDANCE).Value = Range(COLUMN_ATTENDANCE & i).Value Then
                If "" <> Range(COLUMN_FOLDER & i).Value Then
                        createkDir (Range(COLUMN_FOLDER & i).Value)
                End If
            End If
        Next i
    Else
        MsgBox ("出力先フォルダが指定されていません。")
    End If
End Function

' 機能:フォルダ作成

' 機能説明:なし

' 引数:

' 返り値:

' 備　考:なし

Public Function createFolderByExcelList()

Dim endRowCount As Long

Dim attendanceStr As String

Dim attendanceRow As Integer

Dim result As Boolean

'--最終行の取得

endRowCount = Cells(Rows.Count, COLUMN_FOLDER).End(xlUp).Row

'--開始行の取得

attendanceRow = getAttendanceRow()

'出力先のフォルダが指定されている場合、フォルダを出力する

If isOutPutFolder() Then

For i = attendanceRow To endRowCount

'--出力対象のフォルダのみ出力

If Range(RANGE_ATTENDANCE).Value = Range(COLUMN_ATTENDANCE & i).Value Then

If "" <> Range(COLUMN_FOLDER & i).Value Then

createkDir (Range(COLUMN_FOLDER & i).Value)

End If

Next i

Else

MsgBox ("出力先フォルダが指定されていません。")

End If

End Function

表の開始行番号を取得する

'
' 機    能:開始行数を取得
'
' 機能説明:なし
'
' 引    数:なし
'
' 返 り 値:開始行数
'
' 備  　考:なし
'
Public Function getAttendanceRow() As Integer
    Dim myRange     As Range
    Dim myObj       As Range
    Dim keyWord     As String
    Dim maxRow As Integer
    
    Set myRange = Range(RANGE_ATTENDANCE_COLUMN)
    keyWord = Range(RANGE_ATTENDANCE).Value
    Set myObj = myRange.Find(keyWord, LookAt:=xlWhole)
    getAttendanceRow = myObj.Row
    
End Function

' 機能:開始行数を取得

' 機能説明:なし

' 引数:なし

' 返り値:開始行数

' 備　考:なし

Public Function getAttendanceRow() As Integer

Dim myRange As Range

Dim myObj As Range

Dim keyWord As String

Dim maxRow As Integer

Set myRange = Range(RANGE_ATTENDANCE_COLUMN)

keyWord = Range(RANGE_ATTENDANCE).Value

Set myObj = myRange.Find(keyWord, LookAt:=xlWhole)

getAttendanceRow = myObj.Row

End Function

出力先フォルダが指定されているかチェックする

'
' 機    能:出力先フォルダの指定チェック
'
' 機能説明:なし
'
' 引    数:なし
'
' 返 り 値:TRUE:指定あり/FALSE：指定なし
'
' 備  　考:なし
'
Public Function isOutPutFolder() As Boolean
    If Range(RANGE_FOLDER_PATH).Value = "" Then
        isOutPutFolder = False
    Else
        isOutPutFolder = True
    End If
End Function

' 機能:出力先フォルダの指定チェック

' 機能説明:なし

' 引数:なし

' 返り値:TRUE:指定あり/FALSE：指定なし

' 備　考:なし

Public Function isOutPutFolder() As Boolean

If Range(RANGE_FOLDER_PATH).Value = "" Then

isOutPutFolder = False

Else

isOutPutFolder = True

End If

End Function

フォルダを作成する

'
' 機    能:フォルダの作成
'
' 機能説明:なし
'
' 引    数:folderName フォルダ名
'
' 返 り 値:なし
'
' 備  　考:なし
'
Public Function createkDir(folderName As String)
        MkDir Range(RANGE_FOLDER_PATH).Value + folderName
End Function

' 機能:フォルダの作成

' 機能説明:なし

' 引数:folderName フォルダ名

' 返り値:なし

' 備　考:なし

Public Function createkDir(folderName As String)

MkDir Range(RANGE_FOLDER_PATH).Value + folderName

End Function

全文

VBAの全文です、コピペでOK！
ボタンのイベント設定を忘れずに！

'*****************************************************
' 機　能：フォルダ作成ツール
'*****************************************************


'*****************************************************
' 定数
'*****************************************************

'--フォルダ出力先パス
Const RANGE_FOLDER_PATH As String = "B6"

'--宛先対象文字列セル
Const RANGE_ATTENDANCE As String = "C4"

'--宛先 列範囲
Const RANGE_ATTENDANCE_COLUMN As String = "B:B"

'--メール送信対象区分文字列
Const RANGE_ATTENDANCE_KUBUN As String = "C6"

'--作成 列
Const COLUMN_ATTENDANCE As String = "B"

'--フォルダ名 列
Const COLUMN_FOLDER As String = "C"

'--フォルダ階層区切り
Const SEPARATION As String = "\"


'*****************************************************
' イベント
'*****************************************************

'
' 機    能:フォルダ作成ボタンクリック
'
' 機能説明:なし
'
' 引    数:
'
' 返 り 値:
'
' 備  　考:なし
'
Private Sub btnCreateFolder_Click()

   createFolderByExcelList

End Sub


'
' 機    能:フォルダ出力先指定ボタンクリック
'
' 機能説明:なし
'
' 引    数:
'
' 返 り 値:
'
' 備  　考:なし
'
Private Sub btnSelectOutputPath_Click()

    Dim strOutputPath As String
    
    '現在指定されている出力先を取得
    strOutputPath = Range(RANGE_FOLDER_PATH).Value
    
    'フォルダ選択ダイアログにて、出力先のフォルダパスを取得
    With Application.FileDialog(msoFileDialogFolderPicker)
      .InitialFileName = strOutputPath
        'キャンセルした場合、処理を終了する
        If .Show = 0 Then
        Exit Sub
        Else
            strOutputPath = .SelectedItems(1) + SEPARATION
        End If
    End With
    
    '出力先フォルダパスをExcelに出力
    Range(RANGE_FOLDER_PATH).Value = strOutputPath

End Sub


'*****************************************************
' 関数
'*****************************************************

'
' 機    能:フォルダ作成
'
' 機能説明:なし
'
' 引    数:
'
' 返 り 値:
'
' 備  　考:なし
'
Public Function createFolderByExcelList()
    Dim endRowCount As Long
    Dim attendanceStr As String
    Dim attendanceRow As Integer
    
      Dim result As Boolean
    
    '--最終行の取得
    endRowCount = Cells(Rows.Count, COLUMN_FOLDER).End(xlUp).Row
    
    '--開始行の取得
    attendanceRow = getAttendanceRow()
        
    '出力先のフォルダが指定されている場合、フォルダを出力する
    If isOutPutFolder() Then
        For i = attendanceRow To endRowCount
            '--出力対象のフォルダのみ出力
            If Range(RANGE_ATTENDANCE).Value = Range(COLUMN_ATTENDANCE & i).Value Then
                If "" <> Range(COLUMN_FOLDER & i).Value Then
                        createkDir (Range(COLUMN_FOLDER & i).Value)
                End If
            End If
        Next i
    Else
        MsgBox ("出力先フォルダが指定されていません。")
    End If
End Function


'
' 機    能:開始行数を取得
'
' 機能説明:なし
'
' 引    数:なし
'
' 返 り 値:開始行数
'
' 備  　考:なし
'
Public Function getAttendanceRow() As Integer
    Dim myRange     As Range
    Dim myObj       As Range
    Dim keyWord     As String
    Dim maxRow As Integer
    
    Set myRange = Range(RANGE_ATTENDANCE_COLUMN)
    keyWord = Range(RANGE_ATTENDANCE).Value
    Set myObj = myRange.Find(keyWord, LookAt:=xlWhole)
    getAttendanceRow = myObj.Row
    
End Function

'
' 機    能:フォルダの作成
'
' 機能説明:なし
'
' 引    数:folderName フォルダ名
'
' 返 り 値:なし
'
' 備  　考:なし
'
Public Function createkDir(folderName As String)
        MkDir Range(RANGE_FOLDER_PATH).Value + folderName
End Function


'
' 機    能:出力先フォルダの指定チェック
'
' 機能説明:なし
'
' 引    数:なし
'
' 返 り 値:TRUE:指定あり/FALSE：指定なし
'
' 備  　考:なし
'
Public Function isOutPutFolder() As Boolean
    If Range(RANGE_FOLDER_PATH).Value = "" Then
        isOutPutFolder = False
    Else
        isOutPutFolder = True
    End If
End Function

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

'*****************************************************

' 機　能：フォルダ作成ツール

'*****************************************************

' 定数

'*****************************************************

'--フォルダ出力先パス

Const RANGE_FOLDER_PATH As String = "B6"

'--宛先対象文字列セル

Const RANGE_ATTENDANCE As String = "C4"

'--宛先列範囲

Const RANGE_ATTENDANCE_COLUMN As String = "B:B"

'--メール送信対象区分文字列

Const RANGE_ATTENDANCE_KUBUN As String = "C6"

'--作成列

Const COLUMN_ATTENDANCE As String = "B"

'--フォルダ名列

Const COLUMN_FOLDER As String = "C"

'--フォルダ階層区切り

Const SEPARATION As String = "\"

'*****************************************************

' イベント

'*****************************************************

' 機能:フォルダ作成ボタンクリック

' 機能説明:なし

' 引数:

' 返り値:

' 備　考:なし

Private Sub btnCreateFolder_Click()

createFolderByExcelList

End Sub

' 機能:フォルダ出力先指定ボタンクリック

' 機能説明:なし

' 引数:

' 返り値:

' 備　考:なし

Private Sub btnSelectOutputPath_Click()

Dim strOutputPath As String

'現在指定されている出力先を取得

strOutputPath = Range(RANGE_FOLDER_PATH).Value

'フォルダ選択ダイアログにて、出力先のフォルダパスを取得

With Application.FileDialog(msoFileDialogFolderPicker)

.InitialFileName = strOutputPath

'キャンセルした場合、処理を終了する

If .Show = 0 Then

Exit Sub

Else

strOutputPath = .SelectedItems(1) + SEPARATION

End If

End With

'出力先フォルダパスをExcelに出力

Range(RANGE_FOLDER_PATH).Value = strOutputPath

End Sub

'*****************************************************

' 関数

'*****************************************************

' 機能:フォルダ作成

' 機能説明:なし

' 引数:

' 返り値:

' 備　考:なし

Public Function createFolderByExcelList()

Dim endRowCount As Long

Dim attendanceStr As String

Dim attendanceRow As Integer

Dim result As Boolean

'--最終行の取得

endRowCount = Cells(Rows.Count, COLUMN_FOLDER).End(xlUp).Row

'--開始行の取得

attendanceRow = getAttendanceRow()

'出力先のフォルダが指定されている場合、フォルダを出力する

If isOutPutFolder() Then

For i = attendanceRow To endRowCount

'--出力対象のフォルダのみ出力

If Range(RANGE_ATTENDANCE).Value = Range(COLUMN_ATTENDANCE & i).Value Then

If "" <> Range(COLUMN_FOLDER & i).Value Then

createkDir (Range(COLUMN_FOLDER & i).Value)

End If

Next i

Else

MsgBox ("出力先フォルダが指定されていません。")

End If

End Function

' 機能:開始行数を取得

' 機能説明:なし

' 引数:なし

' 返り値:開始行数

' 備　考:なし

Public Function getAttendanceRow() As Integer

Dim myRange As Range

Dim myObj As Range

Dim keyWord As String

Dim maxRow As Integer

Set myRange = Range(RANGE_ATTENDANCE_COLUMN)

keyWord = Range(RANGE_ATTENDANCE).Value

Set myObj = myRange.Find(keyWord, LookAt:=xlWhole)

getAttendanceRow = myObj.Row

End Function

' 機能:フォルダの作成

' 機能説明:なし

' 引数:folderName フォルダ名

' 返り値:なし

' 備　考:なし

Public Function createkDir(folderName As String)

MkDir Range(RANGE_FOLDER_PATH).Value + folderName

End Function

' 機能:出力先フォルダの指定チェック

' 機能説明:なし

' 引数:なし

' 返り値:TRUE:指定あり/FALSE：指定なし

' 備　考:なし

Public Function isOutPutFolder() As Boolean

If Range(RANGE_FOLDER_PATH).Value = "" Then

isOutPutFolder = False

Else

isOutPutFolder = True

End If

End Function

まとめ：Excelの表でフォルダ作成を管理できる

Excelの表からフォルダを作成できるようにすると

作成するフォルダの管理がしやすくなりますね

備考列に、このフォルダは何のフォルダなのか等

説明を残すことができます

小さなことでもプログラム化すれば生産性が向上します

ぜひ活用して下さいね