使用VBA查询目录和目录中的所有子文件夹，并在特定文件扩展的列a中返回完整的filepath。

What I am looking to do is to list all files in a directory and its sub directory with a specific extension such as .pdb

我要做的是列出一个目录中的所有文件及其子目录中的特定扩展名，如.pdb

And return those results to say Column A.

然后返回结果为A列。

The following Code works but I am unsure of the syntax to use to only return a specific file extension type.

下面的代码可以工作，但是我不确定使用什么语法只返回特定的文件扩展类型。

    Sub ListFiles()
Const sRoot     As String = "Y:\Engineering\Database Versions\Chillers"
Dim t As Date

Application.ScreenUpdating = False
With Columns("A:C")
    .ClearContents
    .Rows(1).Value = Split("File,Size,Date", ",")
End With

t = Timer
NoCursing sRoot
Columns.AutoFit
Application.ScreenUpdating = True
End Sub

Sub NoCursing(ByVal sPath As String)
Const iAttr     As Long = vbNormal + vbReadOnly + _
      vbHidden + vbSystem + _
      vbDirectory
Dim col         As Collection
Dim iRow        As Long
Dim jAttr       As Long
Dim sFile       As String
Dim sName       As String

If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

Set col = New Collection
col.Add sPath

iRow = 1

Do While col.count
    sPath = col(1)

    sFile = Dir(sPath, iAttr)

    Do While Len(sFile)
        sName = sPath & sFile

        On Error Resume Next
        jAttr = GetAttr(sName)
        If Err.Number Then
            Debug.Print sName
            Err.Clear

        Else
            If jAttr And vbDirectory Then
                If Right(sName, 1) <> "." Then col.Add sName & "\"
            Else
                iRow = iRow + 1
                If (iRow And &H3FF) = 0 Then Debug.Print iRow
                Rows(iRow).Range("A1:C1").Value = Array(sName, _
                                                        FileLen(sName), _
                                                        FileDateTime(sName))
            End If
        End If
        sFile = Dir()
    Loop
    col.Remove 1
Loop
End Sub

1 个解决方案

#1

Change your Else...End If part with below code and it will only print files with .pdb extension.

其他改变你的…结束If部分与下面的代码，它将只打印文件与。pdb扩展。

'Your existing code
Else
    If InStr(1, sName, ".pdb", vbTextCompare) > 0 Then
        iRow = iRow + 1
        If (iRow And &H3FF) = 0 Then Debug.Print iRow
        Rows(iRow).Range("A1:C1").Value = Array(sName, _
                                                FileLen(sName), _
                                                FileDateTime(sName))
    End If
End If
'Your existing code