フォルダの操作

【ExcelVBA】存在しない中間フォルダも含めてフォルダを作成するFunctionモジュール

フォルダを作成したいとき、パスに含まれる最下層フォルダのみならず、中間階層に位置するフォルダも同時に作成したい場合があるかと思います。

本ページで紹介しているモジュールは、今のところエラーも特になく、業務で問題なく使用できているので、よろしければ皆様も使ってみてください。

1.使用例

1.サンプル

サンプルとして、空っぽのフォルダ「C:\Users\VBA」があったとします。
empty_folder

2.Functionの実行例

以下は実行例になります。
注意点として、引数pathに指定するフォルダパスの最大長さは、Windows10であれば、パスに使用できる文字数上限256文字以下にして下さい。

Sub main()

    FC_CreateDir path:="C:\Users\VBA\フォルダ1\フォルダ2"

End Sub

3.実行結果

下図の通り、存在してなかった中間フォルダ「フォルダ1」も含め、上記実行例で指定した「フォルダ2」までのパスが作成されています。
create_folder

 

2.コード

以下はFunctionモジュールのプログラムになります。
右上のコピーボタンを押せば、プログラム全体をコピーできます。

Function FC_CreateDir(path As String)
'存在しない中間フォルダも含めてフォルダを作成する。
'path:フォルダ名を指定する。Windows10のパスに使用できる文字数上限256文字に注意すること。

    Dim i As Long
    Dim path__ As String
    Dim dirArray__() As String: ReDim dirArray__(UBound(Split(path, "\")))
    Dim fso__ As Object: Set fso__ = CreateObject("Scripting.FileSystemObject")
    
    '動的配列へ分割したフォルダ名を格納
    dirArray__ = Split(path, "\")

    'ドライブの割り当てがされているか否かで条件分岐
    If Left(path, 2) = "\\" Then
        For i = 2 To UBound(dirArray__)
            If i = 2 Then
                path__ = "\\" & dirArray__(i)
            Else
                path__ = path__ & "\" & dirArray__(i)
                If fso__.FolderExists(path__) = False Then
                    fso__.CreateFolder (path__)
                End If
            End If
            
        Next i
    Else
        For i = 0 To UBound(dirArray__)
            If i = 0 Then
                path__ = dirArray__(i)
            Else
                path__ = path__ & "\" & dirArray__(i)
                If fso__.FolderExists(path__) = False Then
                    fso__.CreateFolder (path__)
                End If
            End If
        Next i
    End If
    
End Function

-フォルダの操作
-,