[VBA] mkdir 폴더 생성

윈도우의 폴더를 생성하는 함수는 mkdir 이다.

fPath = "C:\abc\"

If Len(Dir(fPath, vbDirectory)) = 0 Then  MKDir fPath

'// 폴더가 없으면 폴더를 생성하라.

테스트를 해보니 폴더를 2단계까지 없는 것은 생성을 못한다. 에러가 난다.

없는 폴더가 1단계인 것은 바로 생성을 한다.

Sub File_MKDir_Rename()
    Dim rngC, rngAll As Range
    Dim oldName, newName As String
    Dim oldPath, newPath As String
   
    For Each rngC In Selection
        oldPath = Cells(rngC.Row, "A") & "\"
        newPath = Cells(rngC.Row, "A") & "\song\temp\"
        oldName = oldPath & Cells(rngC.Row, "B")
        newName = newPath & Cells(rngC.Row, "B")
       
        If Dir(oldName, vbDirectory) = "" Then  '// 파일이 없다면
            Cells(rngC.Row, "C").Value = "파일없음"
        Else
            If Len(Dir(newPath, vbDirectory)) = 0 Then MkDir newPath
            '// newPath 가 없으면 생성하라
            If Dir(newName, vbDirectory) = Empty Then
                Name oldName As newName
                Cells(rngC.Row, "A") = newPath
                Cells(rngC.Row, "C").Value = "Move"
            Else
                Cells(rngC.Row, "C").Value = "동일파일 존재"
            End If
        End If
    Next rngC
End Sub

위와 같은 폴더생성 코드를 만들면 에러가 발생할 수 있다.

아래와 같이 MKDir 생성하는 코드를 만들어야 문제가 없다.

파일 리스트.xlsm

Sub File_MKDir_Rename()
    Dim rngC, rngAll As Range
    Dim oldName, newName As String
    Dim oldPath, newPath As String
    Dim i%
   
    For Each rngC In Selection
        oldPath = Cells(rngC.Row, "A") & "\"
        newPath = Cells(rngC.Row, "A") & "\song\temp\"
        oldName = oldPath & Cells(rngC.Row, "B")
        newName = newPath & Cells(rngC.Row, "B")
       
        If Dir(oldName, vbDirectory) = "" Then  '// 파일이 없다면
            Cells(rngC.Row, "C").Value = "파일없음"
        Else
            If Len(Dir(newPath, vbDirectory)) = 0 Then  '// 폴더가 없으면 폴더를 생성하라
                Dim PathLoc%: PathLoc = 1   '// inStr 함수는 시작이 1부터 이므로 1 이상의 숫자가 필요
                Debug.Print "Ubound = " & UBound(Split(newPath, "\"))
                For i = 1 To UBound(Split(newPath, "\"))
                    If Dir(Left(newPath, InStr(PathLoc, newPath, "\")), vbDirectory) = Empty Then
                        MkDir Left(newPath, InStr(PathLoc, newPath, "\"))
                    End If
                    PathLoc = InStr(PathLoc, newPath, "\") + 1
       Debug.Print "PathLoc = " & PathLoc & " i = " & i & " " & Left(newPath, InStr(PathLoc, newPath, "\")) & vbCr
                Next i
            End If
            If Dir(newName, vbDirectory) = Empty Then
                Name oldName As newName
                Cells(rngC.Row, "A") = newPath
                Cells(rngC.Row, "C").Value = "Move"
            Else
                Cells(rngC.Row, "C").Value = "동일파일 존재"
            End If
        End If
    Next rngC
End Sub

* MKDir 코드 생성 부분은 http://www.abyul.com/zbxe/110014 참조하였음