Excel VBAでフォルダを再帰的に作成するコード

Excel VBAからフォルダを階層的に深く掘り下げて作成する場合のコードを2つ紹介します。

VBA標準のMKDIRコマンドでは「C:¥上位フォルダ¥中間フォルダ¥下位フォルダ」とフォルダを指定した場合、「パスが見つかりません」とエラーになります。

よって、MKDIRコマンドだけで実装するのであれば以下の処理が必要になります。

MKDIR C:¥上位フォルダ
MKDIR C:¥上位フォルダ¥中間フォルダ
MKDIR C:¥上位フォルダ¥中間フォルダ¥下位フォルダ

単体でのフォルダ作成ならまだしも、自動化には不向きなコードですね。

フォルダを再帰的に作成するVBAコードその1

1つ目はDLLのSHCreateDirectoryExを使用するコードです。

Declare PtrSafe Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" (ByVal hwnd As Long, ByVal pszPath As String, ByVal psa As Long) As Long
                                                                  
Sub subフォルダを再帰的に作成する処理()
    
    Dim int結果 As Integer
    Dim str対象フォルダ As String
    
    str対象フォルダ = "C:\AAA\BBB"
    
    int結果 = SHCreateDirectoryEx(0&, str対象フォルダ, 0&)
    If int結果 = 0 Then
        MsgBox str対象フォルダ & vbCrLf & vbCrLf & " フォルダを作成しました", vbInformation
    ElseIf int結果 = 183 Then
        MsgBox str対象フォルダ & vbCrLf & vbCrLf & " フォルダは既にあります", vbInformation
    Else
        MsgBox str対象フォルダ & vbCrLf & vbCrLf & " 何らかの理由により該当フォルダを作成できませんでした", vbExclamation
    End If
    
End Sub

コードを見れば処理内容もわかると思いますので、説明は割愛します。

フォルダを再帰的に作成するVBAコードその2

SHCreateDirectoryExが動かない場合やライブラリであるSHELL32.dllが制限を受けて動作しない場合の回避策として、2つ目はコマンドプロンプトのMKDIRコマンドで実装します。

Sub subBATコマンドでフォルダを再帰的に作成する処理()
    
    Dim strBATコマンド As String
    Dim strフォルダパス As String
    Dim int結果 As Integer
    Dim wsh As Object
    Set wsh = CreateObject("WScript.Shell")
    
    strフォルダパス = "C:\AAA\BBB\CCC"
    
    If Dir(strフォルダパス, vbDirectory) <> "" Then
        MsgBox strフォルダパス & vbCrLf & vbCrLf & " フォルダが既にあります", vbExclamation
        End
    End If
    
    strBATコマンド = "MKDIR " & strフォルダパス
    int結果 = wsh.Run(Command:="%ComSpec% /c " & strBATコマンド, WindowStyle:=0, WaitOnReturn:=True)
    If (int結果 <> 0) Then
        MsgBox ("フォルダ作成に失敗しました"), vbExclamation
    End If
    
    MsgBox strフォルダパス & vbCrLf & vbCrLf & " フォルダを作成しました", vbInformation
    
End Sub

フォルダ作成前に既存のフォルダ有無を確認しているため、アクセス権が無い場合などを除いてエラーになることは無いかと。

環境やスキルに合ったコードを利用してもらえればと思います。