【VBA】 폴더 경로를 지정하여 폴더를 일괄적으로 생성한다(Dir, MkDir 사용)

폴더 경로를 시트에 입력

비슷한 이름의 폴더를 대량으로 만들 때 사용했습니다.
시트에 다음과 같이 입력된 새 폴더 경로를 만듭니다.


작성 폴더의 입력은 수동으로 패스를 복사해 입력해도 좋고,
【VBA】 다이얼로그에서 선택한 폴더의 패스를 셀에 입력한다
의 기능을 붙여도 좋다고 생각합니다.

오류 유형

생성 폴더가 존재하지 않음

오류 문장: "(작성 폴더 경로)가 없기 때문에 만들지 않았습니다."

새 폴더가 이미 존재합니다.

오류 문구 : "새 폴더가 이미 존재하기 때문에 만들지 않았습니다."

기타 어떤 오류

폴더에 사용할 수 없는 문자, 256자 이상의 경로, 웹 폴더 등의 경우 네트워크 오류 등
오류 문장 : "지정된 경로에 어떤 불법이 있습니다."

코드

이번에는 Dir를 사용하여 폴더의 존재 확인 등을 실시하고 있습니다.FSO 에서 해도 좋네요.

Public Sub btnMakeFld_Click()
    If MsgBox("フォルダを作成しますか？", vbYesNo + vbQuestion, "確認") = vbYes Then
        '「はい」を選んだ場合処理開始
        Dim LastRow As Long '新フォルダ最終行格納用
        LastRow = FldSheet.Cells(Rows.Count, 3).End(xlUp).Row '最終行格納
        '処理結果を最終行までクリア
        FldSheet.Range(FldSheet.Cells(4, 2), FldSheet.Cells(4, LastRow)).ClearContents

        Dim MainFld As String '作成フォルダパス格納用
        Dim NewFldPath As String '新フォルダパス格納用
        Dim i As Long
        For i = 2 To LastRow
            MainFld = FldSheet.Cells(i, 1).Value '作成フォルダパス格納
            NewFldPath = FldSheet.Cells(i, 3).Value '新フォルダパス格納
            '行番号、作成フォルダ、新フォルダを引数として渡してフォルダ作成マクロ呼び出し
            Call FldProcess.MakeFld(i, MainFld, NewFldPath)
        Next i
        MsgBox "処理が完了しました ＼(´∀｀)／" & vbCrLf & _
               "処理結果を確認してください。"
     Else
      '「いいえ」を選んだ場合処理中止
        MsgBox "処理を中断します　(>_<)"
    End If
End Sub

'=========================================
'フォルダ作成処理
'=========================================
Public Sub MakeFld(i As Long, MainFld As String, NewFldPath As String)
'＝＝＝＝作成フォルダが存在してるか確認
    Dim MainFldChk As String '1階層前のフォルダ存在確認用
    MainFldChk = Dir(MainFld, vbDirectory) '作成フォルダの存在確認
    If Len(MainFldChk) <> 0 Then
'＝＝＝＝新フォルダが既に存在してるか確認
        Dim NewFldChk As String
        NewFldChk = Dir(NewFldPath, vbDirectory) '作成フォルダの存在確認
            If Len(NewFldChk) = 0 Then '新フォルダが存在しなけMainFldば
                On Error GoTo eh
                MkDir NewFldPath '新フォルダを作る
                On Error GoTo 0
                FldSheet.Cells(i, 4).Value = "〇" '成功として〇を記載
            Else ''新フォルダが存在したらエラー内容を処理結果に書き込み
                FldSheet.Cells(i, 4).Value = "新フォルダは既に存在しているため作成しませんでした"
            End If
'＝＝＝＝
    Else '作成フォルダが存在しなかったらエラー内容を処理結果に書き込み
        FldSheet.Cells(i, 4).Value = MainFld & "が存在しないため作成しませんでした"
    End If
'＝＝＝＝
    Exit Sub
eh: '処理中に予期せぬエラーが起きたらここにスキップしてエラー内容を処理結果に書き込み
    FldSheet.Cells(i, 4).Value = "指定されたパスに何らかの不正があります"
End Sub

【실행 결과】


로컬이라면 순식간에 많이 만들 수 있습니다.
사내 웹 폴더에서 좀 더 시간이 걸리면 네트워크가 끊어지거나 하는 것이 원인인지 MkDir에서 오류가 발생하는 경우가 드물게 발생했습니다.
다시 시도하면 성공적으로 만들 수 있으므로 이러한 오류가 발생하면 다시 실행합니다.

와타시 흐름 조건

파일이나 폴더를 취급할 때 Dir파와 FSO파로 헤어지지만 와타시는 어느쪽이나 사용하고 있습니다.FSO 쪽이 회피할 수 있는 에러도 많고 이점도 많을지도.
존재 확인만이라면 귀찮아서 Dir로 끝납니다.

다른 경우에 FSO 를 사용한 파일 조작의 코드를 남기고 싶습니다.