Application.FileSearch in Excel 2007

Question

There is an issue which I am facing after I installed Office 2007.  I had written a small VBA which would search for a file and if found will rename the file.

I used Application.FileSearch then.  Now I am tying to do it again but unfortunately there is an error prompted stating that 'the object does not exist'

Set fSearch = Application.FileSearch

defPath = "H:\SourceSafe_1_Feb-28_Feb_2006\SecondSet"

Set rg = Range("MyFiles")
fSearch.LookIn = defPath

I have been frantically looking for changes in the VBA object model especially for Excel but cant seem to find them.

Answer 1

Hi,

I only have 2003 so this is just advice rather than an absolute answer. In the VBA Editor use the Object Browser and do a search (or browse) for the Application object. See if the FileSearch object is there.

If that doesn't help can you find a feature on the GUI to do the File Search. If you can record a macro and that will give you an idea of what legacy code to use.

I hope that helps.

Answer 2

I am having this same problem as well doing a very similar thing but in Excell. The code is as follows

    Set fs = Application.FileSearch
   
    With fs
        'retrieve all .doc files in DB directory
       
        .lookin = [Internal Functions].dirName
        .fileName = "*.doc"
        .Execute
        fC = .foundfiles.Count
        If fC = 0 Then Exit Sub

etc. etc. Its easy to see what its doing.

If anyone has a workaround for this or knows whether they replaced this function with a different name please post it! I have looked for hours and been unable to figure out a reciprocal command, nor why they would take it out of the language. Thanks so much!

 

John

Answer 3

Hi

I went back to using VBScript to get the job done

here is a snippet

Function ReportFileStatus(filespec)
   Dim fso, msg
   Set fso = CreateObject("Scripting.FileSystemObject")
   If (fso.FileExists(filespec)) Then
      msg = filespec & " exists."
   Else
      msg = filespec & " doesn't exist."
   End If
   ReportFileStatus = msg
End Function

this should do the job for you... ofcourse with a bit of modification. 
Make sure that you save the file in XLS format rather than the new XLSX format.

Glax

Answer 4

Thought I'd just put a quick reply to this as I was having trouble with this file searching process.  I used it in Access and then tried to use it when writing an Outlook macro, with no joy.  I think it is specific to Access, because I managed to change my code as follows and it now works.  Know this post is old, but if anyone has the same problem as us, could save hours of frustration. (You need to add the 'Microsoft Access 9.0 Object Library' to your references).

Sub processFiles()

Dim app02 As New Access.Application
Dim filename
Dim NumFiles
NumFiles = 0

line1:
With Access.Application.FileSearch
    .NewSearch
    .LookIn = "C:\Temp\Dataprep\"
    .SearchSubFolders = False
    .MatchTextExactly = True
    .filename = "*.*"
    .Execute

End With

If FileSearch.FoundFiles.Count > 0 Then
filename = FileSearch.FoundFiles.Item(1)

'Put your code that processes files here

Name filename As Left(filename, 17) & "processed\" & Mid(filename, 18, 60)
NumFiles = NumFiles + 1
GoTo line1
Else

End If
MsgBox NumFiles & " File(s) Processed!", vbOKOnly, "Finished!"
End Sub

All this code does is loop through the dataprep folder and place all the files it finds in a 'processed' sub folder.

This is placed in an excel module and seems to do the trick.  I know the code's probably badly written but hope it will be of use to someone.

 

Answer 5

Have a quick look at my response to the original question. Hope that helps mate.

Answer 6

Thanks! Brilliant!

DieZeL wrote:

Hi I went back to using VBScript to get the job done here is a snippet Function ReportFileStatus(filespec) Dim fso, msg Set fso = CreateObject("Scripting.FileSystemObject") If (fso.FileExists(filespec)) Then msg = filespec & " exists." Else msg = filespec & " doesn't exist." End If ReportFileStatus = msg End Function this should do the job for you... ofcourse with a bit of modification. Make sure that you save the file in XLS format rather than the new XLSX format. Glax

Answer 7

[quote user="DieZeL"]

Function ReportFileStatus(filespec)
   Dim fso, msg
   Set fso = CreateObject("Scripting.FileSystemObject")
   If (fso.FileExists(filespec)) Then
      msg = filespec & " exists."
   Else
      msg = filespec & " doesn't exist."
   End If
   ReportFileStatus = msg
End Function

Glax

Thats great!

But your function works only to find whether specific file exist or doesn't exist. Is there a way to find whether any files exist in the particular folder. If yes loop through all existing files.

I need to find all existing files and run some other code. Can u plz help to find all those files...
Thankyou.

Answer 8

sorry, Dear Danny,

".FileSearch."

it's no more time standard in 2007, SEVEN!

 

 

Answer 9

please look this niceFine link; it's the most I like in MSDN Scripting Runtime Library

FileSystemObject Sample Code

it's a great sample, a little bit too much ragged and cleved logic with procedures, but: all you need!

or use "CreateObject("Scripting.FileSystemObject")" as searchWord in MicrosoftMSDN

Answer 10

Application.FileSearch has been deprecated from Excel 2007.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
http://PeltierTech.com
_______

Answer 11

But if you look in help you can see in searching SearchScope this:

Sub DisplayAvailableScopes()

    'Declare a variable that references a
    'SearchScope object.
    Dim ss As SearchScope

    'Use a With...End With block to reference the
    'FileSearch object.
    With Application.FileSearch

        'Loop through the SearchScopes collection.
        For Each ss In .SearchScopes
            Select Case ss.Type
                Case msoSearchInMyComputer
                    MsgBox "My Computer is an available search scope."
                Case msoSearchInMyNetworkPlaces
                    MsgBox "My Network Places is an available search scope."
                Case msoSearchInOutlook
                    MsgBox "Outlook is an available search scope."
                Case msoSearchInCustom
                    MsgBox "A custom search scope is available."
                Case Else
                    MsgBox "Can't determine search scope."
            End Select
        Next ss
    End With
End Sub

Filesearch exist or not in Access 2007, what do you think ?????

Answer 12

I don't know about Access. I do know .FileSearch is gone from Excel 2007. I also know that there is little practical information available yet on the changes to VBA or the Office 2007 Object Models.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
http://PeltierTech.com
_______

Answer 13

9 months later, is there any practical information available now?

Answer 14

There has been little in the way of KB articles. Have you looked at the online help? That's what I was trying to use in January to explore the object model, but it was not yet mature enough, and using the object browser alone was also not very useful.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
http://PeltierTech.com
_______

Answer 15

Jon Peltier wrote:

There has been little in the way of KB articles. Have you looked at the online help? That's what I was trying to use in January to explore the object model, but it was not yet mature enough, and using the object browser alone was also not very useful. - Jon ------- Jon Peltier, Microsoft Excel MVP Tutorials and Custom Solutions http://PeltierTech.com _______

 

I have also had problems. is there not a replacement. i use excell for quoting.

i do a search to count the number of files to auto increment the number in the file name.

then save the file. This worked fine under 2003.......but that was then.

any one with an idea for a workaround would be appreciated.

thanx

 

Michael

 

CODE

 

Private Sub Save_Quote_Click()
Dim Fname, Dname, nf, hr, response, mystring
Dim objShell  As Shell
Dim objFolder As Folder
  

        Range("C10").Select
    
    Dname = GetFolder(CSIDL_PERSONAL) + "\Quotes\"
    Fname = Range("d5")
    ActiveWorkbook.BuiltinDocumentProperties.Item("Comments").Value = Range("System_Comments")
   
With Application.FileSearch
    .NewSearch
    .LookIn = Dname
    .Filename = Left(Fname, Len(Fname) - 1) + "*.xls"
    .FileType = msoFileTypeExcelWorkbooks

    If .Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending) > 0 Then
       ' MsgBox "There were " & .FoundFiles.Count & _
        " file(s) found."
       
        nf = .FoundFiles.Count
        Fname = Fname & "_" & nf
       

        If Range("New_File") = 0 Then MsgBox "Saving As " & ActiveWorkbook.Name: _
        ActiveWorkbook.Save Else Range("New_File") = 0
        response = MsgBox("Saving As " & Dname & Fname, vbYesNo, "Hare And Now Consulting Inc.")
            If response = vbYes Then    ' User chose Yes.
                mystring = "Yes"
            Else    ' User chose No.
                End
            End If

        ActiveWorkbook.SaveAs _
        Filename:=Dname & Fname, _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
       
    Else
        Range("New_File") = 0
         response = MsgBox("Saving As " & Dname & Fname, vbYesNo, "Hare And Now Consulting Inc.")
            If response = vbYes Then    ' User chose Yes.
                mystring = "Yes"    ' Perform some action.
            Else    ' User chose No.
                End  ' Perform some action.
            End If
        ActiveWorkbook.SaveAs Filename:=Dname & Fname, _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
       
    End If
End With
 Range("C10").Select
 ActiveWorkbook.Saved = True
End Sub

 

 

Answer 16

Anyone have any news about this "feature"????  I just found out about it trying to run one of my macros after installing Office 2007.  Thanks in advance!!!!

 

Answer 17

No news. FileSearch is gone and is going to stay that way.

 

Earlier in this thread, someone posted a FSO solution, and you can use Dir just as effectively. Look up File System Object or VB File System for guidance.

 

You might also take a shot at Googling "FileSearch replacement", because some time back I saw a class module someone had posted that essentially mimics the FileSearch functionality.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
Peltier Technical Services, Inc. - http://PeltierTech.com
_______

 

Answer 18

Hi!

I've prepare an example to you (with FSO). This is a recursive function, which returns last found file. It quite simple and you can use this code:

 

'Procedure to launch
Sub FileSearch()

 

Dim sStartPath As String
Dim sWhat As String
Dim result As String

sStartPath = "C:\Archive\" 'Where?
sWhat = "test.log" 'What?
result = DigIn(sStartPath, sWhat) 'First step
MsgBox result

 

End Sub

 

Function DigIn(sPath As String, sWhat As String) As String

Dim fs As New FileSystemObject
Dim dDirs As Folder
Dim dDir As Folder
Dim fFile As File

Set dDirs = fs.GetFolder(sPath)

For Each dDir In dDirs.SubFolders
    DigIn = DigIn(dDir.Path, sWhat) ' Here is the recursion
Next
For Each fFile In dDirs.Files
    If fFile.ShortName = sWhat Then ' File checking
        DigIn = fFile.Path
        Exit Function ' You can remove that if you don't want to wait for all files
    End If
Next

 

End Function

 

Answer 19

Hi,

I've another, easy to use, solution for the FileSearch replacement, when no recursion is needed.
I'm using Dir and a Collection to process all the files of one type in a directory.
It works with Winword, Access an Excel and you can add, rename or delete files in the directory.

 

Sub File_Search()

 

    Dim Coll_Docs As New Collection
    Dim Search_path, Search_Filter, Search_Fullname as String
    Dim DocName As String

    Dim i as Long

 

    Search_Path = "C:\Testpath"   ' where ?
    Search_Filter = "*.doc"            ' what ?
    Set Coll_Docs = Nothing

 

    DocName = Dir(Search_Path & "\" & Search_Filter)

    Do Until DocName = ""            ' build the collection
        Coll_Docs.Add Item:=DocName
        DocName = Dir
    Loop

 

    MsgBox "There were " & Coll_Docs.Count & " file(s) found."
   
    For i = Coll_Docs.Count To 1 Step -1              '
        Search_Fullname = Search_Path & "\" & Coll_Docs(i)

 

    (your code here)

 

    Next

 

End Sub
    
    
   
Jean-Paul

Answer 20

 

Recursion is still required if you went to read files in any subdirectories.

- Jon
-------
Jon Peltier, Microsoft Excel MVP
Tutorials and Custom Solutions
Peltier Technical Services, Inc. - http://PeltierTech.com
_______

Answer 21

Hello,

 

I've found a simple variant (which can avoid "application.filesearch") in the Help file from Access 2007.

I would like to share it with anyone might be interested.

 

Sub ShowFolderList (folderspec)

Dim fs, f, f1, fc, s

Set fs = CreateObject ("Scripting.FileSystemObject")

Set f = fs.GetFolder(folderspec)

Set fc = f.Files

For Each f1 in fc

s = s & f1.name

s = s & vbCrLf

Next

MsgBox s

End Sub

 

'Just replace "folderspec" with the correct path (like Set f = fs.GetFolder ("C:\My Documents")) and it should run.

 

Best regards,

Bogdan

Answer 22

I can't believe what I am reading here.  I just upgraded my machine to Excel 2007 and ran into the same problem discussed in this thread.  Why on earth would Microsoft remove something that people have written into their tools?  I thought one of the guarantees about using Microsoft products for development was that forward compatibility was guaranteed.  Isn't that why we go to so much trouble to write code the way Microsoft wants us to, so we know the code will still work in future versions?  When I think of all the times in the past we got our hands slapped by Microsoft for circumventing their API and breaking in future versions, I'm beginning to wonder, what's the point?  Even if we do follow their prescribed advice, we are still hosed.

 

We have created several tools at my company that depend on FileSearch; and we have distributed these tools to thousands of people within the company.  Providing us with different ways to accomplish the same task that FileSearch performed for us doesn't help us; we still have to distribute the re-written tool to thousands of people and we don't know who these thousands of people are.  And, because we don't know who these thousands of people are, we are either going to get hit with thousands of Support calls or people will stop using our tools.

 

The other thing that really concerns me is why the MSDN 2007 help topics still reference FileSearch (as someone else pointed out many months ago in this thread).  Why hasn't someone at Microsoft removed those references?  That caused us much more difficulty because by seeing these references, it never occured to us that FileSearch had been removed.  So, we have spent countless hours trying to debug our code.  Geez, why don't I get a topic saying "FileSearch has been removed" when I search help for FileSearch?

 

I'm sorry, but this just doesn't make sense to me.  How could Microsoft do this to their customers?  This will certainly delay our upgrades.

Answer 23

Mezhick wrote:

Hi! I've prepare an example to you (with FSO). This is a recursive function, which returns last found file. It quite simple and you can use this code:   'Procedure to launch Sub FileSearch()   Dim sStartPath As String Dim sWhat As String Dim result As String sStartPath = "C:\Archive\" 'Where? sWhat = "test.log" 'What? result = DigIn(sStartPath, sWhat) 'First step MsgBox result   End Sub   Function DigIn(sPath As String, sWhat As String) As String Dim fs As New FileSystemObject Dim dDirs As Folder Dim dDir As Folder Dim fFile As File Set dDirs = fs.GetFolder(sPath) For Each dDir In dDirs.SubFolders     DigIn = DigIn(dDir.Path, sWhat) ' Here is the recursion Next For Each fFile In dDirs.Files     If fFile.ShortName = sWhat Then ' File checking         DigIn = fFile.Path         Exit Function ' You can remove that if you don't want to wait for all files     End If Next   End Function

 

I got this to work with some modifications (currently testing in Excel 2003, do not yet have 2007).

The compiler didn't like the definition "Dim fs As New FileSystemObject" so I looked up FileSystemObject and found this to be useful http://msdn2.microsoft.com/en-us/library/2z9ffy99.aspx... as it says, you have to have the Scripting library installed (scrrun.dll, or Tools>References>Microsoft Scripting Runtime).  So I changed the definition of the FSO, as highlighted in the code below.

 

Secondly, I had to change the "fFile.ShortName" if-then statement to "fFile.Name" because "ShortName" was looking for an abbreviated filename that uses the tilde "~"

 

But thanks for the code... I hope it works when my company forces us to Office 2007  =P

 

Code Snippet

Function DigIn(sPath As String, sWhat As String) As String

Dim fso
Dim dDirs As folder
Dim dDir As folder
Dim fFile As File

 

Set fso = CreateObject("Scripting.FileSystemObject")

Set dDirs = fso.GetFolder(sPath)

'For Each dDir In dDirs.SubFolders
'    DigIn = DigIn(dDir.Path, sWhat) ' Here is the recursion
'Next
For Each fFile In dDirs.Files
    If fFile.Name = sWhat Then ' File checking
        DigIn = fFile.Path
        Exit Function ' You can remove that if you don't want to wait for all files
    End If
Next

 

End Function

 

 

Answer 24

This is some code I was able to make work in Excel 2007.  It replaces Application.Filesearch, uses wildcards, and looks in subfolders.  It's not the most sophisticated code, but it gets the job done.  I thought I'd post it since I've been having such a hard time finding examples with all three elements in them.

 

Dim lst As New Collection

 

Sub FileSearch()
Dim sStartPath  As String
Dim sWhat       As String
Dim result      As String
Dim t           As Integer
Dim tmp         As String

sStartPath = "C:\archive\" 'Where?
sWhat = "*.pdf" 'What?

If lst.Count > 0 Then
    Do
        lst.Remove lst.Count 'clears list if data already exists
    Loop Until lst.Count = 0
End If
ThisWorkbook.Sheets(1).Columns(1).ClearContents

result = DigIn2(sStartPath, sWhat) 'First step
For t = lst.Count To 1 Step -1
    ThisWorkbook.Sheets(1).Cells(t, 1) = lst(t) 'puts data in 1st sheet, 1st column
    lst.Remove t
Next t
Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
 OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End Sub

 

Function DigIn2(sPath As String, sWhat As String)
   
    Dim fs
    Dim dDirs
    Dim dDir
    Dim fFile
    Dim c       As Variant
    Dim tmp     As String
   
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set dDirs = fs.GetFolder(sPath)
   
    For Each dDir In dDirs.SubFolders
        tmp = DigIn2(dDir.Path, sWhat)
    Next
    tmp = Dir(dDirs.Path & "\" & sWhat)
    If tmp <> "" Then
        Do
            lst.Add dDirs.Path & "\" & tmp
            tmp = Dir
        Loop Until tmp = ""
        Exit Function
    End If
End Function

 

Answer 25

i'm pretty pissed microsoft put the Application.FileSearch out....

now i don't know what to do..

 

sombody know how to make this script work in office 2007 ?

 

 

Dim i As Long
    With Application.FileSearch
        .NewSearch
        .LookIn = NewTemplatePath
        .SearchSubFolders = False
        .FileType = msoFileTypeAllFiles
        If .Execute > 1 Then
            If .FoundFiles.Count = 0 Then
                MsgBox "Error - Er zijn geen .dot bestanden gevonden.", vbCritical
                Exit Sub
            End If
            For i = 1 To .FoundFiles.Count
                If Right(.FoundFiles(i), 3) = "dot" Then
                    Call Me.cboTemplates.AddItem(FileNameOnly(.FoundFiles(i)))
                End If
            Next i
        End If
    End With

Answer 26

Try something like this.

 

'Dim i As Long

Dim tmp
'    With Application.FileSearch
'        .NewSearch
'        .LookIn = NewTemplatePath

 

tmp = Dir(NewTemplatePath & "*.*")

'        .SearchSubFolders = False
'        .FileType = msoFileTypeAllFiles
'        If .Execute > 1 Then

'            If .FoundFiles.Count = 0 Then

 

            If tmp = "" then
                MsgBox "Error - Er zijn geen .dot bestanden gevonden.", vbCritical
                Exit Sub
            End If

'            For i = 1 To .FoundFiles.Count

 

Do
'                If Right(.FoundFiles(i), 3) = "dot" Then

 

                If Right(tmp, 3) = "dot" then
                    Call Me.cboTemplates.AddItem(FileNameOnly(tmp))
                End If

'            Next i

 

Loop Until tmp = ""
'        End If
'    End With

Answer 27

memig wrote:

Try something like this.   'Dim i As Long Dim tmp '    With Application.FileSearch '        .NewSearch '        .LookIn = NewTemplatePath   tmp = Dir(NewTemplatePath & "*.*") '        .SearchSubFolders = False '        .FileType = msoFileTypeAllFiles '        If .Execute > 1 Then '            If .FoundFiles.Count = 0 Then               If tmp = "" then                 MsgBox "Error - Er zijn geen .dot bestanden gevonden.", vbCritical                 Exit Sub             End If '            For i = 1 To .FoundFiles.Count   Do '                If Right(.FoundFiles(i), 3) = "dot" Then                   If Right(tmp, 3) = "dot" then                     Call Me.cboTemplates.AddItem(FileNameOnly(tmp))                 End If '            Next i   Loop Until tmp = "" '        End If '    End With

 

well it seems to work..but when i execute the script it stays in a continuous loop and nothing will respond..

 

any suggestions?

Answer 28

I appologize!  Before Loop Until tmp = "" there should be a line that states tmp = Dir.  Try that and see if it works.

Answer 29

You folks have posted several Excel 2007 compatible (I think) code snippets that collect file names and dive into sub-directories.

 

I'm not following all of this very well....

 

I have a need to process all files found within a specific directory that I supply to the sub, here's my code below (minus the processing part).

 

Any specific suggestions for alternatives in this code for  "FileSearch" ???

 

    
    
With Application.FileSearch
        .NewSearch
        .LookIn = FilePath
        .Filename = "*.txt"
        .SearchSubFolders = False
        .Execute
        
        For i = 1 To .FoundFiles.Count
             
            InFile = .FoundFiles(i)
                         
            Workbooks.Open Filename:=.FoundFiles(i)

' do things with this file

 

Next i

 

End With

 

Answer 30

Found the following which provides a workaround and sample code...

 

Microsoft Help and Support

Answer 31

here is a modified version of jpschmit

 

replacement for application.filesearch.foundfiles Excel 2007

 

Sub test()
Dim Coll_Docs As New Collection
Set Coll_Docs = Nothing
File_Search "filepath", "filename", Coll_Docs

  MsgBox "There were " & Coll_Docs.Count & " file(s) found."
   
    For i = Coll_Docs.Count To 1 Step -1              '
      
        MsgBox Coll_Docs(i)
 
    Next

End Sub

Sub File_Search(rootpath As String, filename As String, ByVal Coll_Docs As Collection)
    Dim DocName As String
    Dim i As Long
    Dim Search_Filter As String
    Search_Filter = "*.*"
   
   DocName = Dir(rootpath & "\" & Search_Filter)
  
    Do Until DocName = ""
     If DocName = filename Then
            Coll_Docs.Add Item:=rootpath + "\" + DocName   //this shows the full path for the doc
     End If
     DocName = Dir
    Loop

   
    Dim fs, f, s
     Set fs = CreateObject("Scripting.FileSystemObject")
     Set f = fs.GetFolder(rootpath)

    Dim subfolder
    Dim rootpathx As String
    Set subfolder = f.subfolders
    For Each f1 In subfolder
        rootpathx = rootpath & "\" & f1.Name
            File_Search rootpathx, filename, ByVal Coll_Docs
          
        Next
End Sub

 

Answer 32

I had the same problem with an Application which uses Excel as a front-end when moving from Excel 2003 to 2007. Here is the rewrite of my code which I solved it with.

 

Public Function SearchFiles(ByVal vsSrcDir As String, ByVal vsSrchFile As String, _
                        rasFileList() As String) As Integer
' This function searches for a file or files (if wildcards are used)
' in a source directory. The filename and source directory
' are passed as parameters. A list of files found are returned in an array,
' with a flag indicating whether files were found.
' Returns:
' 1) 0 if no files
' 2) 1 if files found
' 3) 2 if error occurred

' Declare local variables
Dim oFileS As Object
Dim oFldr As Object
Dim oFileColl As Object
Dim oFile As Object

On Error GoTo errorhandler5
          
    Set oFileS = CreateObject("Scripting.FileSystemObject")
    Set oFldr = oFileS.GetFolder(vsSrcDir)
    Set oFileColl = oFldr.Files
    SearchFiles = 0
    nI = -1
    For Each oFile In oFileColl
        If UCase(oFile.Name) Like UCase(vsSrchFile) Then
                nI = nI + 1
                ReDim Preserve rasFileList(nI)
                rasFileList(nI) = vsSrcDir + UCase(oFile.Name)
                SearchFiles = 1
        End If
    Next
          
    Set oFileS = Nothing
    Set oFldr = Nothing
    Set oFileColl = Nothing
    Set oFile = Nothing
          
Exit Function

errorhandler5:
    SearchFiles = 2
    MsgBox "Function FileAccess.SearchFiles: " & Err.Number & vbTab & Err.Description
End Function

 

Regards.

 

Jeggels

 

Answer 33

I know nothing about macros. Are there any replys that would work with this macro? All replys appreciated.

 

 

 

 

Public Const DrawSheet = "ALLSTATESDRAWS"
Public Const AdminSheet = "Admin"
Public Const SourceDirectory = "c4"

Dim i, f, xPath, ThisFile, lr, xDate, xNum, LastCol, LastRow, findRow, FindCol, rng, xFile
Sub SearchFiles()

Sheets(DrawSheet).Select
answer = MsgBox("Clear existing data from ALLSTATESDRAWS Page?", vbYesNo, "Clear exsiting database?")
If answer = vbYes Then Cells.Clear

LastRow = Range("a65536").End(xlUp).Row
If LastRow < 5 Then LastRow = 5
LastCol = Range("iv1").End(xlToLeft).Column
If LastCol < 2 Then LastCol = 2

'file path
If Right(Sheets(AdminSheet).Range(SourceDirectory), 1) <> "\" Then Sheets(AdminSheet).Range(SourceDirectory) = Sheets(AdminSheet).Range(SourceDirectory) & "\"
xPath = Sheets(AdminSheet).Range(SourceDirectory)

'find all .xls files
With Application.FileSearch
    .NewSearch
    .LookIn = xPath
    .Filename = "*.xls"
    .FileType = msoFileTypeAllFiles
    .Execute
End With
With Application.FileSearch
   
    For i = 1 To .FoundFiles.Count
        f = .FoundFiles(i)
        If Right(f, 3) = "xls" Then
            If CBool(Len(Dir(f))) = True Then GetData
            End If
    Next i
End With

Beep

'sort database
Sheets(DrawSheet).Select
LastRow = Range("a65536").End(xlUp).Row
LastCol = Range("iv1").End(xlToLeft).Column
rng = "a6:" & Cells(LastRow, LastCol).Address
Worksheets(DrawSheet).Range(rng).Sort _
        Key1:=Worksheets(DrawSheet).Range("A1")
        'Key2:=Worksheets("Sheet1").Range("B1")

Beep

End Sub

Sub GetData()

ThisFile = ActiveWorkbook.Name

Workbooks.Open Filename:=f
'find filename
xFile = Replace(ActiveWorkbook.Name, ".xls", "")

'find last row
lr = Range("a65536").End(xlUp).Row
For r = 2 To lr
    xDate = Range("a" & r)
   
    If Val(xDate) > 0 Then
   
    xNum = Range("b" & r) & Range("c" & r) & Range("d" & r)
   
    'find matching row
    rng = "a1:a" & LastRow
    findRow = 0
    findRow = Application.WorksheetFunction.CountIf(Workbooks(ThisFile).Sheets(DrawSheet).Range(rng), xDate)
    If findRow > 0 Then
        xDate = DateValue(xDate) * 1
      
        findRow = Application.WorksheetFunction.Match(xDate, Workbooks(ThisFile).Sheets(DrawSheet).Range(rng), 0)
        Else
        LastRow = LastRow + 1
        findRow = LastRow
        Workbooks(ThisFile).Sheets(DrawSheet).Cells(findRow, 1) = xDate
        End If
   
    'find matching column
    rng = "a1:" & Cells(1, LastCol).Address
    FindCol = 0
    FindCol = Application.WorksheetFunction.CountIf(Workbooks(ThisFile).Sheets(DrawSheet).Range(rng), xFile)
    If FindCol > 0 Then
       
        FindCol = Application.WorksheetFunction.Match(xFile, Workbooks(ThisFile).Sheets(DrawSheet).Range(rng), 0)
        Else
        LastCol = LastCol + 1
        FindCol = LastCol
        Workbooks(ThisFile).Sheets(DrawSheet).Cells(1, FindCol) = xFile
        End If
       
    'dump data to cell at row/column co-ordinates
    Workbooks(ThisFile).Sheets(DrawSheet).Cells(findRow, FindCol) = xNum
   
    End If
   
    Next r
    
ActiveWorkbook.Close

 

End Sub

 

 

Answer 34

ok, this thread has been going for a while and no one has visited for some time. When I noticed that FileSearch was missing after I updated to Office 2007, I decided to recreate the class and save it as a file to import anytime I needed to use it. I tried to use as little code as possible, so if there is some property you would need to add then you may have to add it your self, but this will at least give you most of the funcitonality of the original Class without having to update your existing code too much. You have to just referenct the class and then it can still be used in a with block or however you are accustomed. Here are the two class files that I have, the first I named FileSearch (go figure):

Dim pLookIn As String
Dim pSearchSubFolders As Boolean
Dim pFileName As String

Public FoundFiles As New Collection
       
Public Property Get LookIn() As String
    LookIn = pLookIn
End Property
Public Property Let LookIn(value As String)
    pLookIn = value
End Property
Public Property Get SearchSubFolders() As Boolean
    LookIn = pSearchSubFolders
End Property
Public Property Let SearchSubFolders(value As Boolean)
    pSearchSubFolders = value
End Property
Public Property Get fileName() As String
    fileName = pFileName
End Property
Public Property Let fileName(value As String)
    pFileName = value
End Property
Public Function Execute() As Long
   
        Dim ex As Long
        Dim sLookIn As String
        Dim sDirName As String
        Dim sSubDir As String
        Dim sFileName As String
        Dim ff As FilesFound
   
            Set ff = New FilesFound
            sLookIn = LookIn
            sDirName = Dir(sLookIn, vbDirectory)
            sFileName = Dir(sLookIn & "\", vbNormal)
            Do Until Len(sFileName) = 0
                If sFileName Like fileName Then
                    ff.AddFile sLookIn, sFileName
                    FoundFiles.Add (ff.FoundFileFullName)
                End If
                sFileName = Dir
            Loop
            If SearchSubFolders Then
                Do Until Len(sDirName) = 0
                    If GetAttr(sLookIn & sDirName) = vbDirectory Then
                        sSubDir = sDirName
                        Do Until Len(sFileName) = 0
                            If GetAttr(sDirName) = vbNormal Then
                                sFileName = sDirName
                                ff.AddFile sDirName, sFileName
                                FoundFiles.Add (ff)
                            End If
                        Loop
                    End If
                    sDirName = Dir
                Loop
            End If
   
    Execute = FoundFiles.Count
   
End Function

The second I named FilesFound and the code is as follows:

Public FoundFileFullName As String

Public Function AddFile(path As String, fileName As String)
    FoundFileFullName = path & "\" & fileName
End Function


That should do it.

To use it in your code just create the two class modules and then use it as such:

    Dim sFile as String
    Dim fs As New FileSearh

    With fs
        .LookIn = sPath
        .SearchSubFolders = True
        .fileName = "*"
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
                sFile = .FoundFiles(i)
                    ' your code here

            Next
        End If
    End With

so it works exactly the same. The only difference I know of is, if the file you're looking for may have any extension use "*"  instead of "*.*" as microsoft put out. I was lazy and just did a like comparison instead of breaking out the file extensions. All others should theoretically work fine i.e. "*.xls" or "*.txt"

That's it. Enjoy!!!!!!!!


James

Answer 35

Hi AT T IT,

I sympathise with you. Here a design suggestion that can protect your future development from tier party stupidity. I have done in the past a solution that works a follows;

On all the user computers, I have made a Addin that checks in a supporting file (read only) on the network the type of user. This verification uses the user name in the Excel application. After this verification is done, the user identify is assigned to a given group for which the addin automaticaly uninstall/install a set of addins specific to the user group. The other addins contain specific tools that the user might need for their work and are found in a read-only folder on the network.

When I needed to update the addins on all computers, I just had to make a new version of the addin in question and set the update to due date in the user account file to now for this addin.

You can push a script too... when the user session starts then the script install the new addin. If your users to not share the same network... send by email a installation .cab containing the required installation files.

JR

Answer 36

Mezhick,

Your recursion is nice, but you forgot to check your return for a variable before overwriting. I have highlighted my code below.

Skip

 

Function DigIn(sPath As String, sWhat As String) As String

Dim fs As New FileSystemObject
Dim dDirs As Folder
Dim dDir As Folder
Dim fFile As File

Set dDirs = fs.GetFolder(sPath)

For Each dDir In dDirs.SubFolders
    DigIn = DigIn(dDir.Path, sWhat) ' Here is the recursion
    ' This will allow the function to return a value once it finds the file - smcherniss
    If DigIn Is Not Empty Then 
        Exit Function
    End If
Next
For Each fFile In dDirs.Files
    If fFile.ShortName = sWhat Then ' File checking
        DigIn = fFile.Path
        Exit Function ' You can remove that if you don't want to wait for all files
    End If
Next

 

End Function

Answer 37

This is great.  Im doing an exact thing just with csv files.

Answer 38

I hope everyone can imagin how much damage that responsible has made, who made the descision to eliminate the
Application.FileSearch object from VBA, from Excel? At least we have a big problem now.

In short: It is a shame what ever the genius replacment for Application.FileSearch is, how ever genial it is this replacement.
I call it a very stupid descision to take it out.

When you seek in Google for Application.FileSerach then you can find more then 11'000 entries for Application.FileSearch. Maybe daily more. 

And I think there are more then 11'000 peoples now having one or the other problem in one or the other way.

Lets assume that every 10th engineer writes something Google can find, that would mean, that about 100'000 peopels having problems.

To assess the situation, a problem solfer and developers group has to assess the varying situations and find a solution for the cause. Then Work has to be performed, all over design and implementation up to deployment. Can you imagin how many hours will be spent for this to be fixed?

Given over all, I guess, there are more then 100'000 enginers spending 10 hours each, but I guess its about 50 to 100 hours to cure the problem where ever it exists, then we talk about 1 Million to 10 Milliom hours of work! OK? 

Then multiply this 10 Million work hours by the hourly rate of your company and you have the damage caused by the stupid descision to take Application.FileSearch away from Excel. It can sum up easy to 100 Million up to 1000 Million $ or €.

If every human knows how to use a hammer.OK, then is enforced by an organizuation to us a stone to hit the nails.
Can you imagin the damage caused world wide?

I wonder if someone, hopefully from Microsft can come up with a very good official explanation to tell us at least what has lead to the stupid descision to remove Application.FileSerach from Excel. Maybe we can learn something, maybe not. In any case we all have to fix all our Macros and who pays us to do that?

And if you look about how many used function has been taken out, then the damage is much higher.

Answer 39

stadelma I completely agree with what you are saying, this is unbelievable to me.  I work in a very small I.T. shop and have inherited a vb Excel program that we update every year for the next year's use (it is used for budgeting).  Last year in Excel 2003 I was able to figure out all the vb I needed, as I just needed to make tweaks, yet this year with this new 'missing' feature, I am stumped.  You see, I am not a techie programmer type, but yet I have a bit of an aptitude, and we don't have any programmers on staff in our tiny little i.t. shop, and with the current state of the economy we are not able to procure a programmer for this, and it is a small job for an experienced programmer anyway, at least with our one program.  So I think I have figured out that this is a way for Microsoft to generate more revenue, because when I went to contact their support, I was met with a web page describing the $99 one time question fee!  I guess I'll have to fork that over, well the ailing company I work for will...  This is the 'Bill Gates Tax'.

Answer 40

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

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

Answer 41

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

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

Answer 42

Let's not forget that Microsoft's main concern as a business is making "great money" (peddling software), not "great software", otherwise they'd be another Apple... 

Its o.k to depreciate things - that's progress.  But to leave everyone clueless as to what's going on and what the replacement is for the lost functionality is irresponsible and incompetent.

I still remember when lots of developers adopted VB 6.0 hook, line, and sinker - it became their very reason for existence - with the idea that things would only improve.  Then Microsoft trashed it all to throw together .Net so it would look like they weren't caught flat-footed by the internet revolution (they were - which is why so many other technologies forged internet development - with Microsoft conspicuously absent.)  Many developers felt betrayed.  Some pledged to NEVER leave 6.0 while many others jumped ship altogether to go to Java.

The moral of the story is - don't fall in love with any MS technologies - they have a habit of trashing them for something "completely different" (read that as "creating the need to buy again").

By the way, I noticed that MS was using the term "innovation" a lot in its 2007 product marketing materials.  I thought this was great and long over due until someone inside Redmond told me about the joke going around that "innovation" was the new p.c. term for "oops, we screwed that up!"

Now there's a news tidbit that makes sense! :)

By the way... I used the solution proposed in the previous post and, after slight modification for my particular needs, IT WORKED LIKE A CHARM!!!!!!  Nice going, PaHabr!

Answer 43

Thank you so much P. Havrda!  This worked perfectly with no modification required.

Answer 44

The default SearchSubFolders = False, put .SearchSubFolders = True and it will works fine:

            With Application.FileSearch
                .SearchSubFolders = True

Answer 45

Hi Everyone, you have been so helpful so let me ask if you have a solution to my particular VB Application.FileSearch issue... thanks for all replies! 

Sub GetAllPendingFiles()

    Sheets("Sales Board").Select
    Range("A2").Select

With Application.FileSearch
    .NewSearch
    .LookIn = "\\MAXIMUS\CorpSale\Pending Final"  '<== set the directory
    .SearchSubFolders = False
    .Filename = "*.xls"
    .MatchTextExactly = True
    .FileType = msoFileTypeExcelWorkbooks
    If .Execute() > 0 Then
        MsgBox "There were " & .FoundFiles.Count & _
            " file(s) found."
        For i = 1 To .FoundFiles.Count
            Set wkbk = Workbooks.Open(Filename:=.FoundFiles(i), UpdateLinks:=0)
              wkbk.ActiveSheet.Copy _
              after:=ThisWorkbook.Sheets(1)
            wkbk.Close savechanges:=False
           
        Range("A2:CU2").Select
        Selection.Copy
        Sheets("Sales Board").Select
        ActiveCell.Select
        ActiveSheet.Paste Link:=True
        ActiveCell.Offset(1, 0).Range("A1").Select
                   
        Next i
    Else
        MsgBox "There were no files found."
    End If
End With
 
    Range("A2").Select
    MsgBox "Task completed - 1. Select All Data except Date   2.PRESS F5,THEN CLICK 'SPECIAL'   3.CLICK 'VISIBLE CELLS ONLY'    4.CLICK 'COPY'    5. 'PASTE SPECIAL' AS 'VALUES' INTO THIS FILE: \\WARHORSE\INETPUB\INTRANET\SALES\SALESBOARDWEB   5. SAVE 'SALESBOARDWEB' AND EXIT"
 
 
End Sub

 

 

Answer 46

ok, this thread has been going for a while and no one has visited for some time. When I noticed that FileSearch was missing after I updated to Office 2007, I decided to recreate the class and save it as a file to import anytime I needed to use it. I tried to use as little code as possible, so if there is some property you would need to add then you may have to add it your self, but this will at least give you most of the funcitonality of the original Class without having to update your existing code too much. You have to just referenct the class and then it can still be used in a with block or however you are accustomed. Here are the two class files that I have, the first I named FileSearch (go figure):

Dim pLookIn As String
Dim pSearchSubFolders As Boolean
Dim pFileName As String

Public FoundFiles As New Collection
       
Public Property Get LookIn() As String
    LookIn = pLookIn
End Property
Public Property Let LookIn(value As String)
    pLookIn = value
End Property
Public Property Get SearchSubFolders() As Boolean
    LookIn = pSearchSubFolders
End Property
Public Property Let SearchSubFolders(value As Boolean)
    pSearchSubFolders = value
End Property
Public Property Get fileName() As String
    fileName = pFileName
End Property
Public Property Let fileName(value As String)
    pFileName = value
End Property
Public Function Execute() As Long
   
        Dim ex As Long
        Dim sLookIn As String
        Dim sDirName As String
        Dim sSubDir As String
        Dim sFileName As String
        Dim ff As FilesFound
   
            Set ff = New FilesFound
            sLookIn = LookIn
            sDirName = Dir(sLookIn, vbDirectory)
            sFileName = Dir(sLookIn & "\", vbNormal)
            Do Until Len(sFileName) = 0
                If sFileName Like fileName Then
                    ff.AddFile sLookIn, sFileName
                    FoundFiles.Add (ff.FoundFileFullName)
                End If
                sFileName = Dir
            Loop
            If SearchSubFolders Then
                Do Until Len(sDirName) = 0
                    If GetAttr(sLookIn & sDirName) = vbDirectory Then
                        sSubDir = sDirName
                        Do Until Len(sFileName) = 0
                            If GetAttr(sDirName) = vbNormal Then
                                sFileName = sDirName
                                ff.AddFile sDirName, sFileName
                                FoundFiles.Add (ff)
                            End If
                        Loop
                    End If
                    sDirName = Dir
                Loop
            End If
   
    Execute = FoundFiles.Count
   
End Function

The second I named FilesFound and the code is as follows:

Public FoundFileFullName As String

Public Function AddFile(path As String, fileName As String)
    FoundFileFullName = path & "\" & fileName
End Function


That should do it.

To use it in your code just create the two class modules and then use it as such:

    Dim sFile as String
    Dim fs As New FileSearh

    With fs
        .LookIn = sPath
        .SearchSubFolders = True
        .fileName = "*"
        If .Execute > 0 Then
            For i = 1 To .FoundFiles.Count
                sFile = .FoundFiles(i)
                    ' your code here

            Next
        End If
    End With

so it works exactly the same. The only difference I know of is, if the file you're looking for may have any extension use "*"  instead of "*.*" as microsoft put out. I was lazy and just did a like comparison instead of breaking out the file extensions. All others should theoretically work fine i.e. "*.xls" or "*.txt"

That's it. Enjoy!!!!!!!!


James

Simply brilliant!

I gave up searching MSDN for an answer to the vanishing of Filesearch from VBA.

I came across this thread as the top result in a Google search. Maybe I do not know how to search MSDN but I rarely if ever have any success. 

I rely more and more to Google's amazing searching capability.

Thanks for your contribution and Bravo!

Germain

Answer 47

Thaks Jean-Paul, this worked great!