Don’t see any questions similar to what I am looking for.
I have about 20k+ PDFs stored in various locations on my C drive. I don’t have a complete list of what is available or when they were created.
What I am looking to do is find the names, size and dates that the file was created. These would need to be recorded in an Excel spreadsheet
Note: Some of the PDFs are buried about 6 or 7 folders deep, while some are only 1 folder deep.
Can anybody suggest a way of automatically do it?
I have tried using this code*:
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
However, this seems to return an issue in the 4th line – application.filesearch
I have also tried this*, which works well, but doesn’t go into the folders:
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
Any help would be gratefully appreciated.
- these are codes that I found on the net
Maybe this will help
The main function imports the output from the Dos command:
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
This is how you can call it:
Public Sub testFileTypes() listFileTypes "C:\*", "pdf" 'or: listFileTypes "C:\Temp\*", "pdf" End Sub
It might take a while if you have so many, but it will generate a list similar to this (per drive)