Hi All-
I found a macro to search for files in folder and subfolder, but I need some help changing to read Excel 2007 files as this one does not. Everything else about this macro is perfect except that it does not read 2007 file format. Any help would be great. Thank you.
Option Explicit
Sub SrchForFiles()
Dim i As Long, z As Long, Rw As Long
Dim ws As Worksheet
Dim y As Variant
Dim fLdr As String, Fil As String, FPath As String
y = Application.InputBox("Please Enter File Extension", "Info Request")
If y = False And Not TypeName
= "String" Then Exit Sub
Application.ScreenUpdating = False
'fLdr = BrowseForFolderShell
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
fLdr = .SelectedItems(1)
End With
With Application.FileSearch
.NewSearch
.LookIn = fLdr
.SearchSubFolders = True
.Filename = y
Set ws = ThisWorkbook.Worksheets.Add(Sheets(1))
On Error GoTo 1
2: ws.Name = "FileSearch Results"
On Error GoTo 0
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Fil = .FoundFiles(i)
FPath = Left(Fil, Len(Fil) - Len(Split(Fil, "\")(UBound(Split(Fil, "\")))) - 1)
If Left$(Fil, 1) = Left$(fLdr, 1) Then
If CBool(Len(Dir(Fil))) Then
z = z + 1
ws.Cells(z + 1, 1).Resize(, 4) = _
Array(Dir(Fil), _
FileLen(Fil) / 1000, _
FileDateTime(Fil), _
FPath)
ws.Hyperlinks.Add Anchor:=Cells(z + 1, 1).Resize(, 4), _
Address:=.FoundFiles(i)
End If
End If
Next i
End If
End With
ActiveWindow.DisplayHeadings = False
With ws
Rw = .Cells.Rows.Count
With .[A1:D1]
.Value = [{"Full Name","Kilobytes","Last Modified", "Path"}]
.Font.Underline = xlUnderlineStyleSingle
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
End With
.[E1:IV1 ].EntireColumn.Hidden = True
On Error Resume Next
Range(Cells(Rw, "A").End(3)(2), Cells(Rw, "A")).EntireRow.Hidden = True
Range(.[A2 ], Cells(Rw, "C")).Sort [A2 ], xlAscending, Header:=xlNo
End With
Application.ScreenUpdating = True
Exit Sub
1: Application.DisplayAlerts = False
Worksheets("FileSearch Results").Delete
Application.DisplayAlerts = True
GoTo 2
End Sub
I found a macro to search for files in folder and subfolder, but I need some help changing to read Excel 2007 files as this one does not. Everything else about this macro is perfect except that it does not read 2007 file format. Any help would be great. Thank you.
Option Explicit
Sub SrchForFiles()
Dim i As Long, z As Long, Rw As Long
Dim ws As Worksheet
Dim y As Variant
Dim fLdr As String, Fil As String, FPath As String
y = Application.InputBox("Please Enter File Extension", "Info Request")
If y = False And Not TypeName

Application.ScreenUpdating = False
'fLdr = BrowseForFolderShell
With Application.FileDialog(msoFileDialogFolderPicker)
.Show
fLdr = .SelectedItems(1)
End With
With Application.FileSearch
.NewSearch
.LookIn = fLdr
.SearchSubFolders = True
.Filename = y
Set ws = ThisWorkbook.Worksheets.Add(Sheets(1))
On Error GoTo 1
2: ws.Name = "FileSearch Results"
On Error GoTo 0
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Fil = .FoundFiles(i)
FPath = Left(Fil, Len(Fil) - Len(Split(Fil, "\")(UBound(Split(Fil, "\")))) - 1)
If Left$(Fil, 1) = Left$(fLdr, 1) Then
If CBool(Len(Dir(Fil))) Then
z = z + 1
ws.Cells(z + 1, 1).Resize(, 4) = _
Array(Dir(Fil), _
FileLen(Fil) / 1000, _
FileDateTime(Fil), _
FPath)
ws.Hyperlinks.Add Anchor:=Cells(z + 1, 1).Resize(, 4), _
Address:=.FoundFiles(i)
End If
End If
Next i
End If
End With
ActiveWindow.DisplayHeadings = False
With ws
Rw = .Cells.Rows.Count
With .[A1:D1]
.Value = [{"Full Name","Kilobytes","Last Modified", "Path"}]
.Font.Underline = xlUnderlineStyleSingle
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
End With
.[E1:IV1 ].EntireColumn.Hidden = True
On Error Resume Next
Range(Cells(Rw, "A").End(3)(2), Cells(Rw, "A")).EntireRow.Hidden = True
Range(.[A2 ], Cells(Rw, "C")).Sort [A2 ], xlAscending, Header:=xlNo
End With
Application.ScreenUpdating = True
Exit Sub
1: Application.DisplayAlerts = False
Worksheets("FileSearch Results").Delete
Application.DisplayAlerts = True
GoTo 2
End Sub