VBA;如何從文件夾中提取所有文件名 - 無需使用Application.FileDialog對象

Question

如問題：任務是從文件夾中提取所有文件名，但文件夾路徑需要硬編碼到宏中，以防止這些對話框向我提出問題並浪費我的時間。 我不會更改此文件夾。直到時間結束時它將是同一個，我想從第二行開始將文件名提取到Excel列中。 這是我想從中提取所有文件名的文件夾。 「C：\ Users \用戶的Michal \網盤\ CSV \波薩\ mstcgl_mst \」

這是我的代碼部分：

Option Explicit 
Sub GetFileNames() 
Dim axRow As Long   ' inside the Sheet("Lista") row# 
Dim xDirectory As String 
Dim xFname As String  ' name of the file  
Dim InitialFoldr$   
Dim start As Double 
Dim finish As Double 
Dim total_time As Double 

start = Timer 
ThisWorkbook.Sheets("Lista").Range("D2").Activate 
    InitialFolder = "C:\Users\michal\SkyDrive\csv\bossa\mstcgl_mst" 
    If Right(InitialFolder, 1) <> "\" Then 
    InitialFolder = InitialFolder & "\" 
    End If 

    Application.InitialFolder.Show 

    If InitialFolder.SelectedItems.Count <> 0 Then  
     xDirectory = .SelectedItems(1) & "\" 
     xFname = Dir(xDirectory, vbArchive) 
      ' Dir's job is to return a string representing 
      ' the name of a file, directory, or an archive that matches a specified pattern. 
      Do While xFname <> "" ' there is already xFname value (1st file name) assigned. 
       ActiveCell.Offset(xRow) = xFname           
       xRow = xRow + 1 ' następny xRow 
       xFname = Dir()  
      Loop     
    End If 
End With 

finish = Timer        ' Set end time. 
total_time = Round(finish - start, 3)  ' Calculate total time. 
MsgBox "This code ran successfully in " & total_time & " seconds", vbInformation 

End Sub 

這是壓碎行： If InitialFolder.SelectedItems.Count <> 0 Then xDirectory = .SelectedItems(1) & "\"

而.png文件中兩個更重要的問題。 請回復他們 - 這對我來說非常重要。

或者如果你們知道其他方法可以更快地做到這一點，只要不要猶豫，與我分享你的代碼 - 我將非常感激。

Answer 1

Sub Files() 
Dim sht As Worksheet 
Dim strDirectory As String, strFile As String 
Dim i As Integer: i = 1 

Set sht = Worksheets("Sheet1") 
strDirectory = "C:\Users\User\Desktop\" 
strFile = Dir(strDirectory, vbNormal) 

Do While strFile <> "" 
    With sht 
     .Cells(i, 1) = strFile 
     .Cells(i, 2) = strDirectory + strFile 
    End With 
    'returns the next file or directory in the path 
    strFile = Dir() 
    i = i + 1 
Loop 
End Sub 

Answer 2

見下

Public Sub Listpng() 
Const strFolder As String = "C:\SomeFolder\" 
Const strPattern As String = "*.png" 
Dim strFile As String 
strFile = Dir(strFolder & strPattern, vbNormal) 
Do While Len(strFile) > 0 
Debug.Print strFile '<- view this in Immediate window; Ctrl+g will take you there 
strFile = Dir 
Loop 
End Sub 

Answer 3

例子還有我用這取決於我是否希望子文件夾，以及一對夫婦的程序。

這遍歷文件夾，並將路徑&名集合：

Sub Test1() 
    Dim colFiles As Collection 
    Dim itm As Variant 

    Set colFiles = New Collection 

    EnumerateFiles "C:\Users\michal\SkyDrive\csv\bossa\mstcgl_mst\", "*.xls*", colFiles 

    For Each itm In colFiles 
     Debug.Print itm 
    Next itm 
End Sub 

Sub EnumerateFiles(ByVal sDirectory As String, _ 
    ByVal sFileSpec As String, _ 
    ByRef cCollection As Collection) 

    Dim sTemp As String 

    sTemp = Dir$(sDirectory & sFileSpec) 
    Do While Len(sTemp) > 0 
     cCollection.Add sDirectory & sTemp 
     sTemp = Dir$ 
    Loop 
End Sub 

這第二種方式穿過子文件夾以及返回路徑&名。由於某種原因，如果您將InclSubFolders更改爲False，它只會返回名稱 - 必須對此進行排序。

Sub Test2() 
    Dim vFiles As Variant 
    Dim itm As Variant 

    vFiles = EnumerateFiles_2("C:\Users\michal\SkyDrive\csv\bossa\mstcgl_mst\", "xls*") 

    For Each itm In vFiles 
     Debug.Print itm 
    Next itm 
End Sub 

Public Function EnumerateFiles_2(sDirectory As String, _ 
      Optional sFileSpec As String = "*", _ 
      Optional InclSubFolders As Boolean = True) As Variant 

    EnumerateFiles_2 = Filter(Split(CreateObject("WScript.Shell").Exec _ 
     ("CMD /C DIR """ & sDirectory & "*." & sFileSpec & """ " & _ 
     IIf(InclSubFolders, "/S ", "") & "/B /A:-D").StdOut.ReadAll, vbCrLf), ".") 

End Function