課題・悩み「面倒なフォルダ作成作業を自動化したい」
解決策「フォルダを一括で作成するVBAマクロ」を解説
Excelで日々の作業を効率化するために、VBAを使った自動化は非常に有用です。
特に、大量のフォルダを一括で作成する必要がある場合、手動で行うのは時間がかかり面倒です。
この記事では、Excel VBAを使って指定したフォルダを自動作成する方法を、詳細な解説と共に紹介します。
【フォルダを一括で作成するVBAマクロ】を図解で解説しています。
VBAマクロファイルを配布中。
以下のボタンよりダウンロードしてください。
ダイアログで選択したフォルダに複数のフォルダを作成するVBAマクロのコード
このVBAマクロは、Excelの指定されたセル範囲からフォルダ名を取得し、それに基づいて指定された基本パスの下にフォルダを作成するスクリプトです。
指定された基本パスはExcelシートのB1セルから取得し、フォルダ名はB6セルから始まるセル範囲から取得します。
もしフォルダが既に存在しない場合に新たにフォルダを作成します。
Option Explicit
Sub CreateFolders()
Dim basePath As String
Dim folderName As String
Dim ws As Worksheet
Dim cell As Range
' ThisWorkbookのSheet1を設定
Set ws = ThisWorkbook.Sheets("Sheet1")
' B1セルから基本パスを取得
basePath = ws.Range("B1").Value
' B6セルから始まる範囲でループ
For Each cell In ws.Range("B6:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row) ' 初期位置をB6に変更
folderName = cell.Value
If folderName <> "" Then
' フォルダのフルパスを生成
Dim fullPath As String
fullPath = basePath & "\" & folderName
' フォルダが存在しない場合に作成
If Len(Dir(fullPath, vbDirectory)) = 0 Then
MkDir fullPath
End If
End If
Next cell
End Sub全体の処理の概要
処理の概要と解説
以下の表にそれぞれの処理をまとめました。
ワークシートの設定
ThisWorkbookのSheet1を対象とするワークシートとして設定します。
Set ws = ThisWorkbook.Sheets("Sheet1")基本パスの取得
基本パスをB1セルから取得します。
basePath = ws.Range("B1").Valueセル範囲のループ開始
B6セルから始まる範囲をループしてフォルダ名を取得します。
For Each cell In ws.Range("B6:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)フォルダ名の取得
各セルからフォルダ名を取得します。
folderName = cell.Valueフォルダのフルパス生成
基本パスとフォルダ名を結合してフルパスを生成します。
fullPath = basePath & "\" & folderNameフォルダの存在確認
フォルダが既に存在するかを確認します。
If Len(Dir(fullPath, vbDirectory)) = 0 Thenフォルダの作成
フォルダが存在しない場合、新規に作成します。
MkDir fullPath注意点
大量のデータ
セル範囲が大きい場合、処理に時間がかかることがあります。
操作の不可逆性
VBAマクロで実行した操作は元に戻せないため、特にフォルダ作成操作は慎重に行ってください。
環境設定
このマクロを実行するには、ExcelのVBAマクロが有効になっている必要があります。
また、フォルダを作成する権限があることを確認してください。
必要な環境設定
1. VBAマクロの有効化
Excelのオプションから「マクロの設定」で「すべてのマクロを有効にする」を選択してください。
2. フォルダ作成権限
フォルダを作成する場所に対して書き込み権限があることを確認してください。
自分の環境で変更する必要がある箇所
以下の表に変更箇所をまとめました。
ワークシート名
使用するワークシートの名前を自分の環境に合わせて変更します。
Set ws = ThisWorkbook.Sheets("Sheet1")基本パスを指定するセル
基本パスを指定するセルを自分の環境に合わせて変更します。
basePath = ws.Range("B1").Valueフォルダ名を指定するセル範囲の開始位置
フォルダ名を指定するセル範囲の開始位置を自分の環境に合わせて変更します。
For Each cell In ws.Range("B6:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)ワークシート名
ThisWorkbook.Sheets(“Sheet1”)の”Sheet1″を実際に使用するワークシートの名前に変更します。
例えば、ワークシート名が”Projects”なら、ThisWorkbook.Sheets(“Projects”)となります。
基本パスを指定するセル
ws.Range(“B1”).Valueの”B1″を基本パスが入力されているセルの位置に変更します。
例えば、基本パスがC1セルにあるなら、ws.Range(“C1”).Valueとなります。
フォルダ名を指定するセル範囲の開始位置
ws.Range(“B6
B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row)の"B6"をフォルダ名が入力されているセル範囲の開始位置に変更します。
例えば、フォルダ名がB8セルから始まるなら、ws.Range("B8- B” & ws.Cells(ws.Rows.Count, “B”).End(xlUp).Row)となります。
Option Explicit
Sub CreateFolders()
Dim basePath As String
Dim folderName: String
Dim ws: Worksheet
Dim cell: Range
' フルパス対策の呼び出し
basePath = GetFullPath(ThisWorkbook.Path)
' ThisWorkbookのSheet1を設定
Set ws = ThisWorkbook.Sheets("Sheet1")
' B1セルから基本パスを取得
basePath = ws.Range("B1").Value
' B6セルから始まる範囲でループ
For Each cell In ws.Range("B6:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row) ' 初期位置をB6に変更
folderName = cell.Value
If folderName <> "" Then
' フォルダのフルパスを生成
Dim fullPath As String
fullPath = basePath & "\" & folderName
' フォルダが存在しない場合に作成
If Len(Dir(fullPath, vbDirectory)) = 0 Then
MkDir fullPath
End If
End If
Next cell
End Sub
Function GetFullPath(workbookPath As String) As String
Dim fullPath As String
If Left(workbookPath, 5) = "https" Then
fullPath = Environ("UserProfile") & "\OneDrive"
Else
fullPath = workbookPath
End If
GetFullPath = fullPath
End Functionまとめ
このVBAコードを使用することで、Excelシート上の指定されたセル範囲からフォルダ名を取得し、自動的にフォルダを作成することができます。
適切な設定と注意を払って、効率的なファイル管理を実現しましょう。
コメント