Application.FileSearch Error

  • Thread starter Thread starter Howard31
  • Start date Start date
H

Howard31

Hi all,

I'm using Application.FileSearch in Excel 2007 in a file which is in a USB
memory stick and the files I'm searching are in the same USB in a folder
which is in the same folder as the file I'musing this code and I;m getting an
error "Object doesn't support this action". This is the code I'm using:

Dim FileFound As Variant

With Application.FileSearch
.NewSearch
.LookIn = ThisWorkbook.Path & "\Properties"
.Execute

For Each FileFound In .FoundFiles
If Mid(FileFound, 9) >= PropertyID Then
With
Workbooks("Statement_Invoice_Retrieval_Info.xla").Worksheets("Sheet_ID").Range("PropertyID")

.Value = .Value + 1
PropertyID = .Value
End With
End If
Next FileFound
End With

Any idea what's wrong with the above code?
 
The problem is xl2007. It was improved(?) by removing FileSearch.
To be fair, FileSearch wasn't that reliable in the older xl versions.
You will have to use the Dir function or the Scripting.FileSystemObject.
--
Jim Cone
Portland, Oregon USA



"Howard31"
<[email protected]>
wrote in message
Hi all,
I'm using Application.FileSearch in Excel 2007 in a file which is in a USB
memory stick and the files I'm searching are in the same USB in a folder
which is in the same folder as the file I'musing this code and I;m getting an
error "Object doesn't support this action". This is the code I'm using:

Dim FileFound As Variant
With Application.FileSearch
.NewSearch
.LookIn = ThisWorkbook.Path & "\Properties"
.Execute

For Each FileFound In .FoundFiles
If Mid(FileFound, 9) >= PropertyID Then
With
Workbooks("Statement_Invoice_Retrieval_Info.xla").Worksheets("Sheet_ID").Range("PropertyID")

.Value = .Value + 1
PropertyID = .Value
End With
End If
Next FileFound
End With

Any idea what's wrong with the above code?
 
The code should look something like the code below. I heard that filesearch
was suppose to be fixed in excel 2007. Make sure you have all the office
2007 updates.


PropertyID = 0
Folder = ThisWorkbook.Path & "\Properties\"
FName = Dir(Folder & "*.*")
Do While FName <> ""

If Mid(FName, 9) >= PropertyID Then
With
Workbooks("Statement_Invoice_Retrieval_Info.xla").Worksheets("Sheet_ID").Range("PropertyID")
.Value = .Value + 1
PropertyID = .Value
End With
FName = Dir()
Loop
 
Hi Joel,

I read from other responses that FileSearch was droped from Excel 2007, I
will have to use the Dir statement as you described, I didn't have time yet
to study it properly but I will soon.

Thanks for your help!
 
'!!!! Replacement solution including searching in subdirectories !!!


//----------------------------------------------------------------------
--------------------------

Sub FileSearchByHavrda_Example_of_procedure_calling()
'
' Example of FileSearchByHavrda procedure calling as replacement of
missing FileSearch function in the newest MS Office VBA
' 01.06.2009, Author: P. Havrda, Czech Republic
'

Dim FileNameWithPath As Variant
Dim ListOfFilenamesWithParh As New Collection ' create a collection
of filenames

' Filling a collection of filenames (search Excel files including
subdirectories)
Call FileSearchByHavrda(ListOfFilenamesWithParh, "C:\Temp", "*.xls",
True)

' Print list to immediate debug window and as a message window
For Each FileNameWithPath In ListOfFilenamesWithParh ' cycle for
list(collection) processing
Debug.Print FileNameWithPath & Chr(13)
MsgBox FileNameWithPath & Chr(13)
Next FileNameWithPath

' Print to immediate debug window and message if no file was found
If ListOfFilenamesWithParh.Count = 0 Then
Debug.Print "No file was found !"
MsgBox "No file was found !"
End If

End Sub

//----------------------------------------------------------------------
--------------------------

Private Sub FileSearchByHavrda(pFoundFiles As Collection, pPath As
String, pMask As String, pIncludeSubdirectories As Boolean)
'
' Search files in Path and create FoundFiles list(collection) of file
names(path included) accordant with Mask (search in subdirectories if
enabled)
' 01.06.2009, Author: P. Havrda, Czech Republic
'

Dim DirFile As String
Dim CollectionItem As Variant
Dim SubDirCollection As New Collection

' Add backslash at the end of path if not present
pPath = Trim(pPath)
If Right(pPath, 1) <> "\" Then pPath = pPath & "\"

' Searching files accordant with mask
DirFile = Dir(pPath & pMask)
Do While DirFile <> ""
pFoundFiles.Add pPath & DirFile 'add file name to list(collection)
DirFile = Dir ' next file
Loop

' Procedure exiting if searching in subdirectories isn't enabled
If Not pIncludeSubdirectories Then Exit Sub

' Searching for subdirectories in path
DirFile = Dir(pPath & "*", vbDirectory)
Do While DirFile <> ""
' Add subdirectory to local list(collection) of subdirectories in
path
If DirFile <> "." And DirFile <> ".." Then If ((GetAttr(pPath &
DirFile) And vbDirectory) = 16) Then SubDirCollection.Add pPath &
DirFile
DirFile = Dir 'next file
Loop

' Subdirectories list(collection) processing
For Each CollectionItem In SubDirCollection
Call FileSearchByHavrda(pFoundFiles, CStr(CollectionItem), pMask,
pIncludeSubdirectories) ' Recursive procedure call
Next

End Sub

//----------------------------------------------------------------------
 
!!! Replacement solution including searching in subdirectories !!!


//----------------------------------------------------------------------
--------------------------

Sub FileSearchByHavrda_Example_of_procedure_calling()
'
' Example of FileSearchByHavrda procedure calling as replacement of
missing FileSearch function in the newest MS Office VBA
' 01.06.2009, Author: P. Havrda, Czech Republic
'

Dim FileNameWithPath As Variant
Dim ListOfFilenamesWithParh As New Collection ' create a collection
of filenames

' Filling a collection of filenames (search Excel files including
subdirectories)
Call FileSearchByHavrda(ListOfFilenamesWithParh, "C:\Temp", "*.xls",
True)

' Print list to immediate debug window and as a message window
For Each FileNameWithPath In ListOfFilenamesWithParh ' cycle for
list(collection) processing
Debug.Print FileNameWithPath & Chr(13)
MsgBox FileNameWithPath & Chr(13)
Next FileNameWithPath

' Print to immediate debug window and message if no file was found
If ListOfFilenamesWithParh.Count = 0 Then
Debug.Print "No file was found !"
MsgBox "No file was found !"
End If

End Sub

//----------------------------------------------------------------------
--------------------------

Private Sub FileSearchByHavrda(pFoundFiles As Collection, pPath As
String, pMask As String, pIncludeSubdirectories As Boolean)
'
' Search files in Path and create FoundFiles list(collection) of file
names(path included) accordant with Mask (search in subdirectories if
enabled)
' 01.06.2009, Author: P. Havrda, Czech Republic
'

Dim DirFile As String
Dim CollectionItem As Variant
Dim SubDirCollection As New Collection

' Add backslash at the end of path if not present
pPath = Trim(pPath)
If Right(pPath, 1) <> "\" Then pPath = pPath & "\"

' Searching files accordant with mask
DirFile = Dir(pPath & pMask)
Do While DirFile <> ""
pFoundFiles.Add pPath & DirFile 'add file name to list(collection)
DirFile = Dir ' next file
Loop

' Procedure exiting if searching in subdirectories isn't enabled
If Not pIncludeSubdirectories Then Exit Sub

' Searching for subdirectories in path
DirFile = Dir(pPath & "*", vbDirectory)
Do While DirFile <> ""
' Add subdirectory to local list(collection) of subdirectories in
path
If DirFile <> "." And DirFile <> ".." Then If ((GetAttr(pPath &
DirFile) And vbDirectory) = 16) Then SubDirCollection.Add pPath &
DirFile
DirFile = Dir 'next file
Loop

' Subdirectories list(collection) processing
For Each CollectionItem In SubDirCollection
Call FileSearchByHavrda(pFoundFiles, CStr(CollectionItem), pMask,
pIncludeSubdirectories) ' Recursive procedure call
Next

End Sub

//----------------------------------------------------------------------
 
Back
Top