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

一种方法是将Microsoft Scripting dll引用到您的项目中，并使用scriptobject来获取目录。然后，您需要解析目录条目以获取所需的文件并将它们放在单元格中。我不记得将文件作为scriptobject获取的具体命令，但我确信它在本网站和其他人的各种帖子中都有相当好的代表性。我自己没有提出这个想法，但我完全按照你的要求做了。我只是不记得它需要它的工作簿，或者我会发布一个例子。

另一种选择是打开一个命令提示符并打开好的DOS来将DIR命令输入到文本文件中，然后可以使用excel VBA进行解析。我在这里展示了自己的年龄，但我不知道你真正想知道的是否这是一个可行的选择。

Answer 2

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

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(""" &amp; FileItem.Path &amp; """,""" &amp; "Click Here to Open" &amp; """)"

        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(""" &amp; FileItem.Path &amp; """,""" &amp; "Click Here to Open" &amp; """)"

        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/

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

2 个答案: