如何返回一個文件夾中所有文件的文件路徑？ 這是用於Excel VBA

Question

我有允許我返回單個文件夾中所有文件的文件名的代碼。 但是，我想對其進行修改以查詢文件夾並返回特定文件擴展名的所有文件路徑 。 （在這種情況下，.run文件）

任何幫助，將不勝感激！ 提前致謝。

        Option Explicit 

Sub GetFileNames() 

Dim xRow As Long 
Dim xDirect$, xFname$, InitialFoldr$ 

InitialFoldr$ = "G:\" '<<< Startup folder to begin searching from

       With Application.FileDialog(msoFileDialogFolderPicker) 
         .InitialFileName = Application.DefaultFilePath & "\" 
          .Title = "Please select a folder to list Files from" 
           .InitialFileName = InitialFoldr$ 
             .Show 
              If .SelectedItems.Count <> 0 Then 
                 xDirect$ = .SelectedItems(1) & "\" 
                 xFname$ = Dir(xDirect$, 7) 
                  Do While xFname$ <> "" 
                  ActiveCell.Offset(xRow) = xFname$ 
                  xRow = xRow + 1 
                   xFname$ = Dir 
              Loop 
          End If 
       End With 
   End Sub 

Answer 1

使用Dir函數的Dir一種方法：

Sub FilePaths()

Dim FileName As String
Dim FileMask As String
Dim InputFolder As String
Dim PathsArray() As String
Dim OutputRange As Range

InputFolder = "D:\DOCUMENTS\"
FileMask = "*.xls?"
Application.ScreenUpdating = False

FileName = Dir(InputFolder & FileMask)
ReDim PathsArray(0)
ThisWorkbook.ActiveSheet.Range("A1").CurrentRegion.ClearContents

Do While FileName <> ""
    PathsArray(UBound(PathsArray)) = InputFolder & FileName
    ReDim Preserve PathsArray(UBound(PathsArray) + 1)
    FileName = Dir
Loop

ReDim Preserve PathsArray(UBound(PathsArray))

Set OutputRange = ThisWorkbook.Sheets(1).Range("A1:A" & (UBound(PathsArray)))
OutputRange = WorksheetFunction.Transpose(PathsArray)
ThisWorkbook.ActiveSheet.Range("A1").CurrentRegion.Columns.AutoFit

Application.ScreenUpdating = True

MsgBox UBound(PathsArray) & " file(s) listed from folder:" & vbNewLine & InputFolder

End Sub

應該定義源路徑和文件掩碼（ 允許使用 通配符 *? ）。

提供了示例文件： https : //www.dropbox.com/s/j55p8otdiw67i7q/FilePaths.xlsm