エクセルVBAでサブフォルダを一括で作る

エクセルVBAを使うと、サブフォルダを一気に作ることができます。


ソースコード

Sub CreateDirecotires()
  Dim RootPath As String
  RootPath = Cells(1, 2).Value
  
'RootPathが指定されていない場合には、このBookの場所をRootPathとする
  If RootPath = "" Then
    RootPath = ThisWorkbook.Path
  End If
  
  Dim Row As Long
  Row = 3
  
  Do While Cells(Row, 2).Value <> ""
    Dim CreateDirPath As String
    CreateDirPath = RootPath & "¥" & Cells(Row, 2).Value
      
'作ろうとするディレクトリが存在していない場合だけ、フォルダを作成
    If Dir(CreateDirPath, vbDirectory) = "" Then
      MkDir CreateDirPath
    End If
 
    Row = Row + 1
  Loop
End Sub

マクロの実行結果（動画）

このマクロを実行すると、次のように、自動的にフォルダが作成されます。

※下記を再生しても音は出ませんので、音が出せない環境でもご安心ください。

解説

どこにフォルダを作るかを決定

  Dim RootPath As String
  RootPath = Cells(1, 2).Value
  
'RootPathが指定されていない場合には、このBookの場所をRootPathとする
  If RootPath = "" Then
    RootPath = ThisWorkbook.Path
  End If

変数RootPathで指定されるフォルダの下に、フォルダを作っていきます。

そこで、まず変数RootPathに値を設定します。

3行目
  RootPath = Cells(1, 2).Value

基本的には、RootPathにB1セルの値を指定します。

6行目～8行目
  If RootPath = "" Then
    RootPath = ThisWorkbook.Path
  End If

ただし、RootPathが空欄の場合（＝B1セルが空欄の場合）には、このマクロが置かれているパス（ThisWorkbook.Path）を指定します。

ループ処理の骨格

  Dim Row As Long
  Row = 3
  
  Do While Cells(Row, 2).Value <> ""
    Dim CreateDirPath As String
    CreateDirPath = RootPath & "¥" & Cells(Row, 2).Value
      
'作ろうとするディレクトリが存在していない場合だけ、フォルダを作成
    If Dir(CreateDirPath, vbDirectory) = "" Then
      MkDir CreateDirPath
    End If
 
    Row = Row + 1
  Loop

ループ処理の骨格となる部分です。

10行目～11行目
  Dim Row As Long
  Row = 3

変数Rowの初期値を設定します。

13行目
  Do While Cells(Row, 2).Value <> ""

Row行目2列目の値が空欄になったら処理を止めます。
逆に、それまではループ処理を行います。

22行目～23行目
    Row = Row + 1
  Loop

Doループの場合には、カウンタ変数にあたる「Row」を自力で足していく必要があります。
そこで、ループ処理の末尾で「Row」に1を足し「Do While」にもどります。

ループ内部の処理

    Dim CreateDirPath As String
    CreateDirPath = RootPath & "¥" & Cells(Row, 2).Value
      
'作ろうとするディレクトリが存在していない場合だけ、フォルダを作成
    If Dir(CreateDirPath, vbDirectory) = "" Then
      MkDir CreateDirPath
    End If
15行目
    CreateDirPath = RootPath & "¥" & Cells(Row, 2).Value

変数「CreateDirPath」に、作成したいフォルダのフルパスを代入します。

たとえば、

RootPath C:¥temp
"¥" ¥
Cells(Row,2).Value newdir
↓
CreateDirPath C:¥temp¥newdir

となります。

18行目～20行目
    If Dir(CreateDirPath, vbDirectory) = "" Then
      MkDir CreateDirPath
    End If

既にフォルダがある状態で、Mkdir関数を使うとエラーが発生してしまうため、Dir関数を使って、事前にフォルダの存在チェックをします。

「Dir(CreateDirPath, vbDirectory)」で、CreateDirPathに該当するフォルダが既に存在する場合には、そのフォルダ名が取得できます。

逆に、CreateDirPathに該当するフォルダが存在しない場合には「空欄」になります。

そこで、Dir関数の結果が「空欄」の場合にのみ、Mkdirでフォルダを作成します。

注意点

  • 「C:¥Mydocuments」の下に「C:¥Mydocuments¥test4¥test5」というフォルダを作りたい

というように、深い階層のフォルダを作りたい場合には、次のように1階層ずつフォルダを入力します。

B3セル test4
B4セル test4¥test5

このように、2段階に分けてフォルダを作れば、深い階層のフォルダも一気に作ることができます。

エクセル基礎講座 「無料」動画マニュアル

「経理事務のためのエクセル基礎講座（初級編）」（動画マニュアル　総収録時間162分）を無料プレゼント中です！

このマニュアルで解説していることを一通り学べば、経理事務を行う上で最低限必要となる知識が得られます。

ご登録者の方には、合わせて、公認会計士が実体験を通して身に付けたエクセルを使う技をメールにてお伝えしていきます！

無料動画講座　登録フォーム

※ご登録頂いたメールアドレスに、エクセルを使いこなすための情報を配信するメールセミナー「エクセル倍速講座」も合わせて配信させていただきます。

VBAvba