常不軽のブログ（アサブロ）

「多重層のフォルダを作成する」VBAソースコード：

Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" ( _
ByVal hwnd As Long, _
ByVal pszPath As String, _
ByVal psa As Long) As Long

Public Function MkFolder(FL As String) As Boolean
'作成者：jyo_fukyo
'作成日：2024/04/18
'変更日：2024/04/18
'多重層のフォルダ作成

'フォルダの存在確認
If FSO_PH_Check(FL) = True Then
MkFolder = True
Else
'多重層のフォルダ作成
If (MsgBox(FL & "は見つかりませんでした。作成しますか？", 36) = 7) Then
Exit Function
End If
Dim rc As Long
Dim Target As String
Target = FL
rc = SHCreateDirectoryEx(0&, Target, 0&)
If rc = 0 Then
'正常終了
MkFolder = True
Else
'異常終了
MkFolder = False
End If
End If
Exit Function
End Function
Public Function Make_Folder(FL As String) As Boolean
'作成者：jyo_fukyo
'作成日：2024/04/18
'変更日：2024/04/18
'多重層のフォルダ作成

'フォルダの存在確認
If FSO_PH_Check(FL) = True Then
Make_Folder = True
Else
'多重層のフォルダ作成
Dim rc As Long
Dim Target As String
Target = FL
rc = SHCreateDirectoryEx(0&, Target, 0&)
If rc = 0 Then
'正常終了
Make_Folder = True
Else
'異常終了
Make_Folder = False
End If
End If
Exit Function
End Function
Function FSO_PH_Check(Folder_CK As String) As Boolean
'作成者：jyo_fukyo
'作成日：2024/04/18
'変更日：2024/04/18
'フォルダー有無のチェック
'FSOを利用するので、「MicroSoft Scripting Runtime」の参照設定が必須！

Dim cFso As FileSystemObject 'オブジェクト変数宣言

Set cFso = New FileSystemObject '変数にオブジェクトの代入

If cFso.FolderExists(Folder_CK) Then
FSO_PH_Check = True 'フォルダー有り
Else
FSO_PH_Check = False 'フォルダー無し
End If
Exit Function
End Function