有文件夹中的PDF文件。 需要在Excel中logging名称和位置
没有看到类似于我正在寻找的任何问题。
我有大约20K + PDF存储在我的C驱动器上的各个位置。 我没有完整的可用列表或创build时间。
我正在寻找的是find文件的名称，大小和date。 这些需要logging在Excel电子表格中
注意：某些PDF被埋在大约6或7个文件夹深处，而有些仅深度1个文件夹。
有人可以提出一种自动做的方法吗？
我曾尝试使用此代码*：
Sub ListAllFiles() Dim fs As FileSearch, ws As Worksheet, i As Long Dim r As Long Set fs = Application.FileSearch With fs .SearchSubFolders = True ' .FileType = msoFileTypeAllFiles 'can modify to just Excel files eg with msoFileTypeExcelWorkbooks .LookIn = "H:\My Desktop" If .Execute > 0 Then Set ws = Worksheets.Add r = 1 For i = 1 To .FoundFiles.Count If Right(.FoundFiles(i), 3) = ".pdf" Or Right(.FoundFiles(i), 3) = ".tif" Then ws.Cells(r, 1) = .FoundFiles(i) r = r + 1 End If Next Else MsgBox "No files found" End If End With End Sub 但是，这似乎在第四行返回一个问题 – application.filesearch
我也试过这个*，效果很好，但没有进入文件夹：
Sub ListAllFile() Dim objFSO As Object Dim objFolder As Object Dim objFile As Object Dim ws As Worksheet Set objFSO = CreateObject("Scripting.FileSystemObject") Set ws = Worksheets.Add 'Get the folder object associated with the directory Set objFolder = objFSO.GetFolder("H:\My Desktop") ws.Cells(1, 1).Value = "The files found in " & objFolder.Name & " are:" 'Loop through the Files collection For Each objFile In objFolder.Files If UCase$(Right$(objFile.Name, 4)) = ".PDF" Then ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Value = Replace$(UCase$(objFile.Name), ".PDF", "") End If Next 'Clean up! Set objFolder = Nothing Set objFile = Nothing Set objFSO = Nothing End Sub
任何帮助将不胜感激。
- 这些是我在网上find的代码
也许这会有所帮助
主函数导入Dos命令的输出： Dir C:\*.pdf /S | Find "pdf" Dir C:\*.pdf /S | Find "pdf"
Public Sub listFileTypes(Optional ByVal root As String = "C:\*.", _ Optional ByVal ext As String = "pdf") Const MAX_SIZE As Long = 17 'max space reserved for file sizes Dim i As Long, maxRow As Long, maxCol As Long, fInfo As String, ws As Worksheet Dim arrLines As Variant, s As String, pat As String, midSp As Long Application.ScreenUpdating = False Set ws = ActiveSheet ws.Cells.Delete s = CreateObject("WScript.Shell").Exec( _ "%comspec% /C Dir """ & root & ext & """ /S | Find """ & ext & """" _ ).STDOut.ReadAll 'Application.Wait Now + TimeValue("0:00:01") 'built-in replacement for "Sleep" If Len(s) > 0 Then For i = MAX_SIZE To 2 Step -1 s = Replace(s, Space(i), vbTab) 'replace space sets with tabs Next arrLines = Split(s, vbCrLf) maxRow = UBound(arrLines, 1) With ws .Cells(1, 1).Value2 = root & ext For i = 2 To maxRow + 2 If Len(arrLines(i - 2)) > 0 Then maxCol = UBound(Split(arrLines(i - 2), vbTab)) If maxCol > 0 Then .Range( _ .Cells(i, 1), _ .Cells(i, maxCol + 1)) = Split(arrLines(i - 2), vbTab) 'split file size from name fInfo = .Cells(i, maxCol + 1).Value2 midSp = InStr(1, fInfo, " ") .Cells(i, maxCol + 1).Value2 = Mid(fInfo, 1, midSp) .Cells(i, maxCol + 2).Value2 = Mid(fInfo, midSp) End If End If Next .UsedRange.Columns.AutoFit For i = 1 To 3 .Columns(i).EntireColumn.ColumnWidth = .Columns(i).ColumnWidth + 5 Next End With End If Application.ScreenUpdating = True End Sub
这是你可以称之为：
Public Sub testFileTypes() listFileTypes "C:\*", "pdf" 'or: listFileTypes "C:\Temp\*", "pdf" End Sub
如果你有这么多，可能需要一段时间，但它会产生一个类似于这个列表（每个驱动器）
