使用VBA查询目录和目录中的所有子文件夹,并返回特定文件扩展名的A列中的完整文件路径

时间:2017-04-11 15:06:06

标签: excel vba excel-vba

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

并将这些结果返回到A栏。

以下代码有效,但我不确定用于仅返回特定文件扩展名类型的语法。

    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 个答案:

答案 0 :(得分:1)

使用以下代码更改 Else...End 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