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

见下面的例子

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 2

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 3

我使用了几个程序，具体取决于我是否也想要子文件夹。

这循环遍历文件夹并添加路径＆amp;集合的名称：

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

第二种方式遍历子文件夹以及返回路径＆amp;名称。出于某种原因，如果将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

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

3 个答案: