FileSearch Help

[Kevin R]

Now that FileSearch is no longer valid in Word 2007, my code isn't working.
I'm not the best with vba so coming up with the code to work in prior
versions took me a while. Any help here would be appreciated so I can get
this working again. It needs to work with both Word 2003 and 2007 since I
have users running both versions. Basically the user is prompted for a SSN,
searches for files containing that SSN, give the user a list of matches that
they can select and delete from the drive. Here's the FileSearch code that
worked in 2003...

Function FindFiles(SSN As String) As Boolean

Dim ArrayVals() As Variant
Dim Num As Integer
Dim i As Integer
Dim fso As Scripting.FileSystemObject

Set fso = CreateObject("scripting.filesystemobject")

StartSearch:
With Application.FileSearch
.NewSearch
.LookIn = "Q:\"
.SearchSubFolders = True
.FileName = SSN
.MatchTextExactly = False
.FileType = msoFileTypeWordDocuments

' Display wait form - lets user know something is happening
PleaseWait (Chr(13) & "Searching for filenames on Q:\" & Chr(13) &
"containing SSN: " & SSN)

If .Execute(SortBy:=msoSortByNone, SortOrder:=msoSortOrderAscending) > 0
Then
Num = 0
For i = 1 To .FoundFiles.Count
ReDim Preserve ArrayVals(0 To 1, 0 To Num)
ArrayVals(0, Num) = .FoundFiles.Item(i)
'ArrayVals(1, Num) = Dir(.FoundFiles.Item(i))
Num = Num + 1
Next i
DeleteFiles.lbFileList.Column = ArrayVals ' Fill list with filenames
HideWaitForm
DeleteFiles.Show ' Show list
Else
HideWaitForm
MsgBox "No files found matching SSN: " & SSN, vbOKOnly, "Q: - Search
& Delete by SSN"
Exit Function
End If

End With

End Function

 

[Graham Mayor]

You should probably be able to modify the following to work with your
userforms and do what you require with the found filenames.
Currently it lists the found file paths to the open document.

Option Explicit
Option Compare Text
Private SSN As String
Private FileType As String

Sub FindFiles()
SSN = InputBox("Enter SSN")
Const myPath = "Q:"
FileType = "*" & SSN & "*"
MsgBox FileType
ProcessFiles myPath, FileType
End Sub

Sub ProcessFiles(strFolder As String, strFilePattern As String)
Dim strFileName As String
Dim strFolders() As String
Dim iFolderCount As Integer
Dim oDoc As Document
Dim i As Integer

'Collect child folders
strFileName = Dir$(strFolder & "\", vbDirectory)
Do Until strFileName = ""
On Error Resume Next
If (GetAttr(strFolder & "\" & strFileName) _
And vbDirectory) = vbDirectory Then
If Left$(strFileName, 1) <> "." Then
ReDim Preserve strFolders(iFolderCount)
strFolders(iFolderCount) = strFolder & "\" & strFileName
iFolderCount = iFolderCount + 1
End If
End If
strFileName = Dir$()
Loop

'process files in current folder
strFileName = Dir$(strFolder & "\" & strFilePattern)

Do Until strFileName = ""

'Do things with files here*****************
Selection.TypeText strFolder & "\" & strFileName & vbCr
'Set oDoc = Documents.Open(strFolder & "\" & strFileName)
'oDoc.Close SaveChanges:=wdSaveChanges
'***************************************

strFileName = Dir$()
Loop
'Look through child folders
For i = 0 To iFolderCount - 1
ProcessFiles strFolders(i), strFilePattern
Next i
End Sub

 

[alborg]

Kevin:

The workaround is to do it the "old" way as shown here-
http://www.word.mvps.org/FAQs/MacrosVBA/ReadFilesIntoArray.htm

Al