フォルダの有無を確認して存在しない場合は多重層のフォルダ作成する: 常不軽のブログ（アサブロ）

フォルダの有無を確認して存在しない場合は多重層のフォルダ作成する
業務用のシステムを作るようになると、一般に紹介されている関数の「使えなさ」に苛立つ事がしばしばあります。
その中でフォルダの作成用の関数「MkDir」は私にとっては代表格です。
どうしてそう思うのか？
多重層のフォルダを作成できないからです。
多重層とは、例えばCドライブの下に「123」というフォルダを作って、さらにその下に「456」というフォルダを作成する事です。
「MkDir」Cドライブの下に「123」というフォルダしか作れないのです！

以下に提示した例は、「FSO_PH_Check」でフォルダの有無を確認して、存在しない場合、多重層でもフォルダを作成してくれるロジックです。
↓
'MkFolderで多重層のフォルダ作成に使います（宣言セクションに記述します!）。
Declare Function SHCreateDirectoryEx Lib "shell32" Alias "SHCreateDirectoryExA" ( _
ByVal hwnd As Long, _
ByVal pszPath As String, _
ByVal psa As Long) As Long
’ここからは標準モジュールに記述します。
Function FSO_PH_Check(Folder_CK As String) As Boolean
'フォルダー有無のチェック
'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
End Function
'
Function MkFolder(FL As String) As Boolean
'フォルダの存在確認
If FSO_PH_Check(FL) = True Then
MkFolder = True
Else
If (MsgBox("フォルダ「" & FL & "」が存在しません！作成しますか？？", 4) = 7) Then
MkFolder = True
Exit Function
Else
'多重層のフォルダ作成
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
End If
End Function
↑
業務ツールを作成する場合、関数「MkDir」は大抵の場合、役に立ちません。
多重層のフォルダを作成する事は、お仕事で利用する場合、必須ですからね！