[VBA] 찾고자 하는 파일의 경로명 알아내기

특정한 파일이 어디에 있는지 찾아내고 싶은 경우가 있다.

FileSearch 기능을  구글링해서 찾아낸 코드와 내가 사용하는 코드를 결합해서 작성을 해보고 있는 중이다.

아직은 For Each rngC in Selection 구문으로 여러파일을 선택했을 경우까지는 해결을 못했다.

ActiveCell 이 위치한 파일의 경로명 가져오는 것은 잘 된다.

조금 더 분석해서 For Each rngC in Selection 구문도 해결을 해보련다.

FileSearch.vbs

** 테스트 해보실 분은 이 파일 받아서 EditPlus 같은 텍스트 에디터로 열어서 VBA 코드에 붙여넣고 수정할 부분 수정해서 실행하시면 됩니다.

Option Explicit
Type FoundFileInfo      '// Properties that will be collected for each found file
    sPath As String
    sName As String
End Type

Sub eachFileSearch()
'// [도구] - [참조] 에서 Microsoft Scripting Runtime 라이브러리 체크해야 함
    Dim FSO As New FileSystemObject
    Dim iFilesNum%, iCount%, r%
    Dim recMyFiles() As FoundFileInfo
    Dim blFilesFound As Boolean
    Dim fPath, sName, openMsg As String    
    Dim rngC, rngAll As Range

    On Error Resume Next     '// 에러가 발생해도 계속 수행하라
    openMsg = "파일을 가져올 경로를 직접 지정하려면 Yes를 눌러주세요 " & vbCr & vbCr
    openMsg = openMsg & "현재 경로를 선택하려면 No를 눌러주세요" & vbCr
    openMsg = openMsg & "현재 Path : " & ThisWorkbook.Path + "\"
    If MsgBox(openMsg, vbYesNoCancel) = vbYes Then
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = "C:\Excel Basics"
            .Show
            fPath = .SelectedItems(1)   '// 선택될 폴더를 경로 변수에 저장
        End With
    Else
        fPath = ThisWorkbook.Path + "\"     '// 엑셀 VBA 파일이 위치한 현재경로
    End If
    If Err.Number <> 0 Or fPath = False Then Exit Sub
    On Error GoTo 0

    sName = Cells(ActiveCell.Row, "A")
    If sName = "" Then
        MsgBox "파일이 선택되지 않았습니다"
        Exit Sub    '// 실행 종료
    End If
    blFilesFound = FindFiles(fPath, recMyFiles, iFilesNum, sName, True)
    If blFilesFound Then
        For iCount = 1 To iFilesNum
            With recMyFiles(iCount)
                If iCount = 1 Then
                    Cells(ActiveCell.Row, "B") = .sPath
'                        Cells(activecell.row, "C") = .sName
                Else
                    If Len(Cells(ActiveCell.Row, "B")) And InStr(Cells(ActiveCell.Row, "B"), .sPath) = 0 Then
                        Cells(ActiveCell.Row, "B") = Cells(ActiveCell.Row, "B") & vbNewLine & .sPath
                    End If
                End If
            End With
        Next
    Else
        Cells(ActiveCell.Row, "B") = vbNullString     '// 찾는 파일이 없으면 빈공백
    End If
    MsgBox "완료"
End Sub

Function FindFiles(ByVal sPath As String, ByRef recFoundFiles() As FoundFileInfo, _
    ByRef iFilesFound As Integer, _
    Optional ByVal sFileSpec As String = "*.*", _
    Optional ByVal blIncludeSubFolders As Boolean = False) As Boolean

    Dim iCount As Integer           '// Multipurpose counter
    Dim sFileName As String         '// Found file name
    Dim oFileSystem, oParentFolder, oFolder, oFile As Object    '// FileSystem objects

    Set oFileSystem = CreateObject("Scripting.FileSystemObject")
    On Error Resume Next
    Set oParentFolder = oFileSystem.GetFolder(sPath)
    If oParentFolder Is Nothing Then
        FindFiles = False
        On Error GoTo 0
        Set oParentFolder = Nothing
        Set oFileSystem = Nothing
        Exit Function
    End If
    sPath = IIf(Right(sPath, 1) = "\", sPath, sPath & "\")
    '// Find files
    sFileName = Dir(sPath & sFileSpec, vbNormal)
    If sFileName <> "" Then
        For Each oFile In oParentFolder.Files
            If LCase(oFile.Name) Like LCase(sFileSpec) Then
                iCount = UBound(recFoundFiles)
                iCount = iCount + 1
                ReDim Preserve recFoundFiles(1 To iCount)
                With recFoundFiles(iCount)
                    .sPath = sPath
                    .sName = oFile.Name
                End With
            End If
        Next oFile
        Set oFile = Nothing         '// Although it is nothing
    End If
   
    If blIncludeSubFolders Then     '// sub Folder 를 선택했으면
        For Each oFolder In oParentFolder.SubFolders
            FindFiles oFolder.Path, recFoundFiles, iFilesFound, sFileSpec, blIncludeSubFolders
        Next
    End If
    FindFiles = UBound(recFoundFiles) > 0
    iFilesFound = UBound(recFoundFiles)
    On Error GoTo 0
    '// Clean-up
    Set oFolder = Nothing           '// Although it is nothing
    Set oParentFolder = Nothing
    Set oFileSystem = Nothing
End Function