pgbigorokuのブログ

プログラムの再利用できそうなコードをアップ

EXCEL VBA フォルダ作成

'フォルダ作成
'
'バージョン 2022/8/5
'URL https://pgbigoroku.hatenablog.com/entry/2022/08/05/173125


Private Function pstrフォルダ作成(ByVal pstrNewDir As String, Optional ByVal pstrParentDir As String) As String
    Dim str親フォルダ As String
    Dim intTemp2 As Integer
    If pstrParentDir = "" Then
    Else
        If Right(pstrParentDir, 1) = "\" Then
            pstrNewDir = pstrParentDir & pstrNewDir
        Else
            pstrNewDir = pstrParentDir & "\" & pstrNewDir
        End If
    End If
    intTemp2 = InStrRev(pstrNewDir, "\")
    str親フォルダ = Left(pstrNewDir, intTemp2)
    If IsExistDir(str親フォルダ) Then
        If IsExistDir(pstrNewDir) Then
            pstrフォルダ作成 = "ERR_既にフォルダが存在します。"
        Else
            MkDir pstrNewDir
            If IsExistDir(pstrNewDir) Then
                  pstrフォルダ作成 = "OK          "
            Else
                pstrフォルダ作成 = "ERR_フォルダを作成できませんでした。"
            End If
        End If
    Else
        pstrフォルダ作成 = "ERR_親フォルダがありません。"
    End If
End Function

'フォルダの存在確認
'
'バージョン 2022/8/5
'URL 
[https://pgbigoroku.hatenablog.com/entry/2022/08/05/173021]

Public Function IsExistDir(ByVal pstrSearchDir As String) As Boolean
    Dim objFso
    Set objFso = CreateObject("Scripting.FileSystemObject")
    IsExistDir = objFso.FolderExists(pstrSearchDir)
 End Function