filesearch excel 2003 to 2007

[pablobarra]

Hello

This works fine with excel 2003, but now I´m moving to excel 2007 and don´t know how to change "filesearch" code.
Can anyone help me??
thanks in advanced
_____________________________________
Private Sub Workbook_Open()
Application.DisplayAlerts = False
On Error Resume Next
Dim basebook As Workbook
Dim mybook As Workbook
Dim pt As PivotTable
Dim ws As Worksheet
With Application.FileSearch
.NewSearch
.LookIn = "C:\Consultas\"
.SearchSubFolders = True
.FileType = msoFileTypeExcelWorkbooks
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
Set mybook = Workbooks.Open(.FoundFiles(i), UpdateLinks:=0, IgnoreReadOnlyRecommended:=True, corruptload:=0)
For Each ws In ActiveWorkbook.Worksheets
For Each pt In ws.PivotTables
pt.PivotCache.MissingItemsLimit = xlMissingItemsNone
Next pt
Next ws
ActiveWorkbook.RefreshAll
ActiveWorkbook.Save
ActiveWorkbook.Close
Next i
End If
End With
Application.Quit
End Sub

 

[Kari_]

Hi,

I'm new to VBA and came across this Filesearch problem in excel and cannot fix it by myself. Been a week of hard googling and searching for solution but with no success. Could someone point me into something ready that I could easily use? I pasted the old code here. And sorry for pumping up an old thread.

Sub my_list()
Dim source As String
Dim on_list As Boolean
lahteet = ThisWorkbook.Path + "\EXCEL_queries"
Set fs = Application.FileSearch
Set fsy = CreateObject("Scripting.FileSystemObject")
With fs
.LookIn = source
.Filename = "EXCEL*(query).xls"
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
For i = 1 To .FoundFiles.Count
For j = 1 To ListBox1.ListCount
If fsy.getfilename(.FoundFiles(i)) = ListBox1.List(j - 1) Then
on_list = True
End If
Next j
If Not on_list Then
ListBox1.AddItem (fsy.getfilename(.FoundFiles(i)))
End If
Next i
Else
MsgBox "No queries found."
End If
End With
End Sub

-Kari

 

[tom2977]

Hi, Will something like this work? (I had to take the wildcards out of your search so you'd have to use a fragment of the filename:
Sub my_list()
Dim on_list As Boolean, Path As String, FileList() As String, Filename As String
Path = ThisWorkbook.Path + "\EXCEL_queries"
Filename = "partoffilename" 'no wildcards so have to use a part of filename
Call ListFiles(FileList, Path, Filename, True)
For i = 1 To UBound(FileList)
For j = 1 To ListBox1.ListCount
If FileList(i) = ListBox1.List(j - 1) Then
on_list = True
End If
Next j
If Not on_list Then
ListBox1.AddItem FileList(i)
End If
Next i
End Sub

Sub ListFiles(ByRef FileList() As String, Path As String, originalfilename As String, IncludeSubfolders As Boolean)
Dim i As Integer, Folder As Object, Subfolder As Object
Dim MyObject As Object, Filename As String
Set MyObject = CreateObject("Scripting.FileSystemObject")
Set Folder = MyObject.GetFolder(Path)
Application.StatusBar = "Searching For:" & originalfilename & " In " & Path
Application.EnableEvents = False
Application.DisplayAlerts = False

On Error GoTo NoFilesFound
Filename = Dir(Path & "\*")
If Filename = "" Then GoTo NoFilesFound
On Error Resume Next
i = UBound(FileList) 'For subfolders the array size must not reset to 1!
' Loop until no more matching files are found
Do While Filename <> ""
If InStr(UCase(Filename), UCase(originalfilename)) > 0 Then
ReDim Preserve FileList(i + 1)
FileList(i + 1) = Path & "" & Filename
i = i + 1
End If
Filename = Dir
Loop
NoFilesFound:
'Loop through the subfolders
If IncludeSubfolders Then
For Each Subfolder In Folder.SubFolders
DoEvents
ListFiles FileList, Subfolder.Path, originalfilename, True
Next
End If
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub