Application.FileSearch Error

[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?

 

[Simon Lloyd]

Hi all

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

Dim FileFound As Varian

With Application.FileSearc
.NewSearc
.LookIn = ThisWorkbook.Path & "\Properties
.Execut

For Each FileFound In .FoundFile
If Mid(FileFound, 9) >= PropertyID The
Wit
Workbooks("Statement_Invoice_Retrieval_Info.xla").Worksheets("Sheet_ID").Range("PropertyID"

.Value = .Value +
PropertyID = .Valu
End Wit
End I
Next FileFoun
End Wit

Any idea what's wrong with the above code

-
A. Ch. Eirinber

--
Simon Lloy

Regards,
Simon Lloyd
'The Code Cage' (http://www.thecodecage.com

 

[Jim Cone]

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?

 

[Joel]

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

 

[Howard31]

Thanks Jim, I suspected this.

 

[Howard31]

Thanks Simon, I suspected this.

 

[Howard31]

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!

 

[Dave Peterson]

Ron de Bruin shares a couple of replacements:
http://www.rondebruin.nl/copy3.htm (for Dir())
and
http://www.rondebruin.nl/fso.htm (for FSO)

 

[Kenneth Hobson]

If you like the method of Application.FileSearch, try the class method that
is similar at this link. http://www.mrexcel.com/forum/showthread.php?t=369982

That class uses FSO to iterate the subfolders.

I used it in an example xls.
http://www.4shared.com/file/87591234/8d1d705d/1839452_classFileSearch_and_Excel4.html

 

[Howard31]

Thanks Kenneth

 

[Howard31]

Thanks Dave
--
A. Ch. Eirinberg

Ron de Bruin shares a couple of replacements:
http://www.rondebruin.nl/copy3.htm (for Dir())
and
http://www.rondebruin.nl/fso.htm (for FSO)

 

[Pav Habr]

'!!!! 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

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

 

[Pav Habr]

!!! 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

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