从目录中抓取文件名并放入单元格

Question

我需要在一个文件夹中获取特定文件类型的所有文件名，并将每个文件名放入一个单独的单元格中，最好按行向下。我还需要确保没有任何重复的文件名，并且这适用于任何文件夹，因为它应该是动态的。

基本上，我需要做类似的事情，但循环，我需要检查以确保它不在工作簿中： VBA Get File Name From Path and Store it to a Cell

我在这里尝试过使用 Application.GetOpenFilename、Dir() 函数和其他一些东西：

count files in specific folder and display the number into 1 cel

Using Excel VBA to loop through .csv files in folder and copy the filename into cells in last column

感谢任何帮助，谢谢！

在我使用其他人的代码之前，我的代码非常简单（编程新手）：

Sub Add_Policies()

'let user select folder, go into folder, grab all filenames which end in .htm, put each into a separate cell, one after the other.
'This needs to be dynamic, so probably put in an Update List button. Msgbox "x number of policies were added. There are now a total of y policies."
'check if policy is already present. if so, skip.
'add functionality to open a policy in excel



Dim fldr As FileDialog, nFiles As Integer, fldrName As String, FileDifference As Integer, FileName As String


    'Open the select folder prompt
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = "C:\Users\Hothi\Documents"
        If .Show = -1 Then 'if ok is pressed
            fldrName = .SelectedItems(1)
        End If
    End With


If fldrName <> "" Then

    With fldrName
    path = fldrName & "\*.htm"

    FileName = Dir("path")

    Do While FileName <> ""
        nFiles = nFiles + 1
        FileName = Dir()
    Loop



    For i = 1 To nFiles
        Range("A3").Offset(i, 0) = nFiles
        Range.Value = Dir(



    Next

    If nFiles <> nFiles Then
        msgbox (" & FileDifference & number of policies added. There are now a total of & nFiles & policies.")
        Else: msgbox ("No new policies, check location of new policies.")
    End If



End Sub

Answer 1

执行此操作的代码如下所示。

Sub GetFilesInFolder(SourceFolderName As String)

'--- For Example:Folder Name= "D:\Folder Name\"

Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.folder, SubFolder As Scripting.folder
Dim FileItem As Scripting.File

    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)

    '--- This is for displaying, whereever you want can be configured

    r = 14
    For Each FileItem In SourceFolder.Files
        Cells(r, 2).Formula = r - 13
        Cells(r, 3).Formula = FileItem.Name
        Cells(r, 4).Formula = FileItem.Path
        Cells(r, 5).Formula = FileItem.Size
        Cells(r, 6).Formula = FileItem.Type
        Cells(r, 7).Formula = FileItem.DateLastModified
        Cells(r, 8).Formula = "=HYPERLINK(""" & FileItem.Path & """,""" & "Click Here to Open" & """)"

        r = r + 1   ' next row number
    Next FileItem

    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

Sub GetFilesInFolder(SourceFolderName As String, Subfolders As Boolean)

'--- For Example:Folder Name= "D:\Folder Name\" and Flag as Yes or No

Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.folder, SubFolder As Scripting.folder
Dim FileItem As Scripting.File
'Dim r As Long
    Set FSO = New Scripting.FileSystemObject
    Set SourceFolder = FSO.GetFolder(SourceFolderName)

    '--- This is for displaying, whereever you want can be configured

    r = 14
    For Each FileItem In SourceFolder.Files
        Cells(r, 2).Formula = r - 13
        Cells(r, 3).Formula = FileItem.Name
        Cells(r, 4).Formula = FileItem.Path
        Cells(r, 5).Formula = FileItem.Size
        Cells(r, 6).Formula = FileItem.Type
        Cells(r, 7).Formula = FileItem.DateLastModified
        Cells(r, 8).Formula = "=HYPERLINK(""" & FileItem.Path & """,""" & "Click Here to Open" & """)"

        r = r + 1   ' next row number
    Next FileItem

    '--- This is the Function to go each and Every Folder and get the Files. This is a Nested-Function Calling.

    If Subfolders = True Then
        For Each SubFolder In SourceFolder.Subfolders
            ListFilesInFolder SubFolder.Path, True
        Next SubFolder
    End If

    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

转到下面的链接，向下滚动到名为“立即下载”的按钮，然后单击该按钮下载一个实用程序的副本，该实用程序将为您完成所有工作，正如您所描述的那样。

http://learnexcelmacro.com/wp/2011/11/how-to-get-list-of-all-files-in-a-folder-and-sub-folders/

Answer 2

一种方法是将 Microsoft Scripting dll 引用到您的项目中并使用脚本对象来获取目录。然后，您需要解析目录条目以获取所需的文件并将它们放入单元格中。我不记得将文件作为脚本对象获取的特定命令，但我确信它在本网站和其他网站的各种帖子中得到了很好的体现。我没有自己提出这个想法，但我已经完全按照您的要求完成了。我只是不记得它需要它用于哪个工作簿，否则我会发布一个示例。

另一种选择是打开命令提示符并打破良好的 DOS 以将 DIR 命令输入文本文件，然后您可以使用 excel VBA 进行解析。我在这里展示了我的年龄，但我对你真正想要做的事情知之甚少，不知道这是否是一个可行的选择。