[VBA] 만능폴더 만들기

https://www.youtube.com/watch?v=FYMDU3dvuoY 

같은 오픈채팅방 크루인 다잡님이 올려주신 유튜브 내용을 일부 착안해서 작성하였다.

지금 한시적으로 무료로 이파일을 드린다고 하니 관심 있는 분들은 회원가입후 소장하시길 바란다.

 

정말 배울게 많은 분이다.

본인의 크롤링 스킬의 기본 뼈대를 완성해 주신 분이라서 더욱 이글을 읽는 분들께 알려드리고 싶다.

 

윤자동님 코드를 보지는 못했지만 최대한 비슷한 느낌으로 만들어 보려고 했다.

 

코드의 구성은 심플하다. 폴더 유무를 파악해서 있으면 다음을..없으면 생성하는...

 

조금 까다로운건 부서폴더를 보면 같은부서는 빈셀로 되어 있어서 이부분을 처리하는 코드가 있어야 한다.

빈셀인 부분은 빈셀이 아닌 부서명을 가져오게 된다.  해당셀.end(3) : 현재셀에서 위로 이동해서 빈셀이 아닌 값을 가져오라는 의미이다.

 

또 조금 생각해봐야하는 것은 세부폴더는 카운트가 01부터 시작하기 때문에 부서폴더값이 변경이 되면 처음부터 01값을 만들어줘야 하는데 그 부분은 Boolean으로 처리했다.

 

부서명이 있는 부분을 Boolean값을 True로 주고 그렇지 않은 부분은 False로 줘서 True일때 번호를 01로 초기화 하는 코드를 넣어주면 된다.

 

If Len(rnga(1, 0)) > 0 Then
Bln = True
If Bln = True Then R = 1

마지막으로 이미 폴더가 있는지 없는지를 판단해야 하는데 이는 Function으로 만들어서 불필요한 반복을 피했다.

내가 만들었지만 이정도의 정리 강박이 있는 친구들하고는 그리 친해지고 싶지 않다.

Option Explicit

Sub Make_multi_Folder()
    
    Dim rngAll As Range: Set rngAll = Range([f7], [f7].End(4))
    Dim rnga As Range
    Dim i&, R&, cnt&
    Dim MainFolder$: MainFolder = [b7]
    Dim Bln As Boolean
    Dim str$
    
    Range([g7], [g7].End(4)).ClearContents                                                      '= 초기화
    
    For i = 1 To 2
    
        MainFolder = Make_Folder(MainFolder & "\" & Cells(7, 2 + i))                            '= 메인폴더 만들기
    
    Next i
   
    For Each rnga In rngAll
        cnt = cnt + 1
        If Len(rnga(1, 0)) > 0 Then
            Bln = True
            If Bln = True Then R = 1
            Make_Folder MainFolder & "\" & rnga(1, 0)
            Make_Folder MainFolder & "\" & rnga(1, 0) & "\" & Format(R, "00") & "_" & rnga
            str = MainFolder & "\" & rnga(1, 0) & "\" & Format(R, "00") & "_" & rnga
            R = R + 1
        Else
            Bln = False
            Make_Folder MainFolder & "\" & rnga(1, 0).End(3) & "\" & Format(R, "00") & "_" & rnga
            str = MainFolder & "\" & rnga(1, 0).End(3) & "\" & Format(R, "00") & "_" & rnga
            R = R + 1
        End If
            
        [b4] = cnt / rngAll.Rows.Count                                                          '= 진행바 만들기
        rnga.Next = str
        rnga.Next = Haja_href(rnga.Next, rnga.Next.Value)                                       '= 하이퍼 링크 만들기
        Haja_delay rnga
        
        
    Next rnga
    
    MsgBox "폴더 생성을 완료하였습니다."
    
End Sub

Function Make_Folder(strPath)
    
    If Len(Dir(strPath, vbDirectory)) <= 0 Then
    MkDir (strPath)
    
    End If
    
    Make_Folder = strPath

End Function

Function Haja_delay(rngX As Range)                                                              '= 너무 빨리 끝나서
    Dim i&                                                                                      '= 딜레이를 주는 코드(의미없음)
    
    For i = 1 To Application.RandBetween(100, 150)
        rngX.Select
    Next i
    

End Function

Function Haja_href(rng As Range, url$)

    Dim Ws As Worksheet: Set Ws = ActiveSheet

    Ws.Hyperlinks.Add anchor:=rng, Address:=url, ScreenTip:="폴더연결"
    rng.Font.Underline = xlUnderlineStyleNone
    rng.Font.Color = rgbDarkBlue
    rng.Font.Bold = True
    rng.Font.Size = 11
    
    Haja_href = rng

End Function

만능폴더만들기(23.04.18).xlsm

0.02MB