Excel VBA文件名搜索返回路徑

Question

我正在尋找VBA的幫助，以從文件夾中找到excel Column A列出的文件名，並返回Column B的文件路徑

下面的代碼有效，但是，如果找不到文件名，如果我希望excel跳過該行，則文件路徑結果將直接返回到文件名旁邊的單元格中。

Private Sub CommandButton1_Click()
        Dim sh As Worksheet, rng As Range, lr As Long, fPath As String
        Set sh = Sheets(1) 'Change to actual
       lstRw = sh.Cells.Find(What:="*", After:=sh.Range("A1"), LookAt:=xlWhole, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
        Set rng = sh.Range("A2:A" & lstRw)
        With Application.FileDialog(msoFileDialogFolderPicker)
            .Show
            fPath = .SelectedItems(1)
        End With
        If Right(fPath, 1) <> "\" Then
            fPath = fPath & "\"
        End If
        fwb = Dir(fPath & "*.*")
        x = 2
        Do While fwb <> ""
            For Each c In rng
                If InStr(LCase(fwb), LCase(c.Value)) > 0 Then
                    Worksheets("Sheet2").Range("A" & x) = fwb
                    Set fs = CreateObject("Scripting.FileSystemObject")

                    Set f = fs.GetFile(fPath & fwb)
                    Worksheets("Sheet1").Range("B" & x) = f.Path


                    Set fs = Nothing
                    Set f = Nothing
                    x = x + 1


                End If
            Next
            fwb = Dir
        Loop
        Set sh = Nothing
        Set rng = Nothing
        Sheets(2).Activate

End Sub

Answer 1

如我上面的評論中所述，在范圍循環內使用DIR。 請參閱此示例。

如果Col A中的相應單元格未返回任何內容，則此處不會向Col B輸出任何內容。

Sub Sample()
    Dim sh As Worksheet
    Dim rng As Range
    Dim i As Long, Lrow As Long
    Dim fPath As String, sPath As String

    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        fPath = .SelectedItems(1)
    End With

    If Right(fPath, 1) <> "\" Then
        fPath = fPath & "\"
    End If

    Set sh = ThisWorkbook.Sheets("Sheet1")

    With sh
        Lrow = .Range("A" & .Rows.Count).End(xlUp).Row

        For i = 2 To Lrow
            '~~> Check for partial match
            sPath = fPath & "*" & .Range("A" & i).Value & "*.*"

            If Len(Trim(Dir(sPath))) > 0 Then
                .Range("B" & i).Value = Dir(sPath)
            End If
        Next i
    End With
End Sub

注意：如果您不希望部分匹配，請考慮修改

sPath = fPath & "*" & .Range("A" & i).Value & "*.*"

至

sPath = fPath & .Range("A" & i).Value & ".*"