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 & ".*"