VBA; 如何从文件夹中提取所有文件名 – 而不使用Application.FileDialog对象

正如在问题：任务是提取文件夹中的所有文件名，但文件夹path需要硬编码到macros，以防止这些对话框问我的东西，浪费我的时间。 我不会改变这个文件夹。 直到时间结束，它将是一样的，我想从第二行开始将文件名提取到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文件中。 请回应他们 – 这是非常重要的4我。

或者，如果你们知道其他方法可以更快地做到这一点，只要不要犹豫，与我分享你的代码 – 我将非常感激。

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

有几个我使用的程序取决于我是否也想要子文件夹。

这循环通过该文件夹，并将path和名称添加到集合：

 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 

第二种方式是通过子文件夹以及返回path和名称。 出于某种原因，如果您将InclSubFolders更改为False，则只会返回名称 – 必须对此进行sorting。

 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