フォルダを作成したいとき、パスに含まれる最下層フォルダのみならず、中間階層に位置するフォルダも同時に作成したい場合があるかと思います。
本ページで紹介しているモジュールは、今のところエラーも特になく、業務で問題なく使用できているので、よろしければ皆様も使ってみてください。
目次
1.使用例
1.サンプル
サンプルとして、空っぽのフォルダ「C:\Users\VBA」があったとします。
2.Functionの実行例
以下は実行例になります。
注意点として、引数pathに指定するフォルダパスの最大長さは、Windows10であれば、パスに使用できる文字数上限256文字以下にして下さい。
Sub main()
FC_CreateDir path:="C:\Users\VBA\フォルダ1\フォルダ2"
End Sub
3.実行結果
下図の通り、存在してなかった中間フォルダ「フォルダ1」も含め、上記実行例で指定した「フォルダ2」までのパスが作成されています。
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