[VBA] 파일이 있는 폴더 경로 찾아주기

본 코드는 VBA 고수인 "하나를하더라도최선을"님이 만들어주신 코드에 필요한 걸 추가해서 작성한 코드다.

파일명이 입력된 셀을 기준으로 그 파일이 어느 폴더에 있는지 전부 찾아주는 것이다.

IIF 함수는 PHP 의 삼항연산자 함수와 동일한 기능이다.

IIF(조건,참,거짓) ← 한줄로 조건과 참, 거짓을 표현하므로 코드가 깔끔해진다.

반복횟수처리할 때 오류를 범한 사항이 있어서 수정했다.

SL(SplitLine) 은 적당하게 하는 것이 속도면에서 유리하다. 너무 작게 하는 것도 작업속도를 현저하게 저하시킨다.

하지만, 간단한 자료의 경우에는 몇만 라인인 경우에도 금방 끝나는 걸로 봐서는 SplitLine 의 문제만은 아닌거 같다는 생각이 들었다.

ThisWorkbook.Save 는 정상적으로 수행이 된다면 굳이 한줄 적용해서 속도를 엄청나게 느려지게 할 필요는 없지만, 에러가 발생해서 무반응의 상태가 지속된다면 조금이라도 시간을 아껴볼 요량으로 추가한 것이다.

에러가 발생하면 강제로 Ctrl + Alt + Delete 를 눌러서 엑셀을 강제종료해야 하는 상황이 될 수도 있다.

에러가 발생했을 때 그 부분에서 처리하지 못해서 다음 진행이 제대로 안되어서 인가 하는 생각이 들었다.

On Error Resume Next 이 한줄이 들어가 있느냐 빠뜨리고 있느냐의 차이에서 오는 것인가 하는 생각이 든다.

아직은 좀 더 경험을 해보고 최적의 방안을 찾아봐야겠다.

Sub PathFind()
    Dim Paths As Variant, fPath$, fName$, openMsg$
    Dim rngC, rngDB As Range
    Dim SL, sRow, eRow As Double
    Dim i, n, r As Double, rcnt%
    Dim Col, T As Single
   
    T = Timer()
    Application.DisplayStatusBar = True
    Application.ScreenUpdating = False    '// 화면 업데이트 (일시) 중지
    fPath = "C:\Excel Basics\"
    sRow = Cells(Rows.Count, "A").End(3)(2).Row
    Col = "G"       '// 파일명이 들어있는 열 지정
    SL = 3000    '// 전체행을 모두 범위설정하면 메모리 부족현상으로 속도저하 발생 우려 확인 필요
    rcnt = ((Cells(Rows.Count, Col).End(3).Row - sRow) \ SL) + 1
    Debug.Print "반복횟수 = " & rcnt
    For n = 1 To rcnt
        If (sRow + SL) > Cells(Rows.Count, Col).End(3).Row Then     '// 시작행 + SL 이 마지막행보다 크면
            eRow = Cells(Rows.Count, Col).End(3).Row    '// 마지막 행을
        Else
            eRow = sRow + SL                  '// 마지막 행이 SL 보다 크면
        End If
        Debug.Print "start Row = " & sRow & " || end Row = " & eRow
       
        Set rngDB = Range(Cells(sRow, Col), Cells(eRow, Col))
        For Each rngC In rngDB
            Application.StatusBar = "셀: " & rngC.Address(0, 0) & " / " & rngC.Text & " 진행중..."
            r = rngC.Row

            Files = Empty

            FindFile fPath, rngC.Text
            Cells(r, "A") = Join(Paths, vbLf)
        Next rngC
        Set rngDB = Nothing
        ThisWorkbook.Save   '// 현재까지 작업한 내용을 파일에 저장
        sRow = r + 1  '// 시작행으로 지정
    Next n
    Application.ScreenUpdating = True
    Application.StatusBar = "파일 처리 완료"
    MsgBox "완료!! " & vbLf & vbLf & Format(Timer() - T, "0.00초 걸림"), 64, Now()
End Sub

Function FindFile(fPath$, fName$)
    Dim objFolder, objFso, objFile, objSubFolder
    Set objFso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFso.GetFolder(fPath)
   
    fPath = IIf(Right(fPath, 1) = "\", fPath, fPath & "\")
    If Len(Dir$(fPath & fName)) Then
        Dim n%
        On Error Resume Next
        n = UBound(Files)
        If n Then
            n = n + 1
        Else
            n = 1
            ReDim Files(1 To n)
        End If
        ReDim Preserve Files(1 To n)
        Files(n) = objFolder.Path
        n = 0
    End If

    '// 하위 폴더들을 뒤져가면서 작업을 계속 반복
    For Each objSubFolder In objFolder.SubFolders
        FindFile objSubFolder.Path, fName
    Next
End Function