Solved: replacement for Application.FileSearch

[mduff]

Hi,

I had used this code in the past to import all files in a directory to a one excel workbook but it seems that [VBA]Application.FileSearch [/VBA]no longer works in office 2010 I have tried to search the internet but could not find any fixes


any ideas on how I can get this code to work in XL2010?

thanks

[VBA]Sub puttogether()

Dim fs, numfiles, Direct, dirlen, TheOriginalFile, file_count, filename, tabname
numfiles = 0

TheOriginalFile = ActiveWorkbook.Name

Direct = ActiveWorkbook.Path 'CurDir()
Set fs = Application.FileSearch
With fs
.LookIn = Direct
.FileType = msoFileTypeAllFiles
If .Execute > 0 Then
numfiles = .FoundFiles.Count
Else
MsgBox "There were no files found."
End If
End With

file_count = 1

Do While file_count <= numfiles
If Mid(fs.FoundFiles(file_count), Len(Direct) + 2) = TheOriginalFile Then
'Skips Consolidating File
Else
Workbooks.Open filename:=fs.FoundFiles(file_count)
filename = ActiveWorkbook.Name
tabname = Mid(ActiveWorkbook.Name, 1, Len(ActiveWorkbook.Name) - 4)
Windows(filename).Activate
Sheets(1).Copy After:=Workbooks(TheOriginalFile).Sheets(1)
Windows(filename).Close
Windows(TheOriginalFile).Activate
End If

file_count = file_count + 1
Loop

End Sub
[/VBA]

[Bob Phillips]

[VBA]Sub puttogether()

Dim fs, numfiles, Direct, dirlen, TheOriginalFile, filename, tabname
numfiles = 0

TheOriginalFile = ActiveWorkbook.Name

Direct = ActiveWorkbook.Path 'CurDir()
fs = Dir(Direct & Application.PathSeparator & "*.xl*")
If fs <> "" Then

Do While fs <> ""
If fs = TheOriginalFile Then
'Skips Consolidating File
Else
Workbooks.Open filename:=Direct & Application.PathSeparator & fs
filename = ActiveWorkbook.Name
tabname = Mid(ActiveWorkbook.Name, 1, Len(ActiveWorkbook.Name) - 4)
Windows(filename).Activate
Sheets(1).Copy After:=Workbooks(TheOriginalFile).Sheets(1)
Windows(filename).Close
Windows(TheOriginalFile).Activate
End If

fs = Dir
Loop
Else
MsgBox "There were no files found."
End If
End Sub[/VBA]

[mduff]

thanks a lot

[Kasam]

Hi,
Sorry to bother you with an other Application.FileSearch issue, but I also have problems getting my (old) code to work in Excel 2013 :

'searches excel files matching the strSearch string in the strDir directory
Sub searchSub(strDir As String, strSearch As String)
Dim bool As Boolean
Dim counter As Integer
Dim counter2 As Integer


With Application.FileSearch
    .NewSearch
    .LookIn = strDir
    .FileType = msoFileTypeExcelWorkbooks
    .SearchSubFolders = True
    .Filename = strSearch
    .Execute msoSortByFileName
    For counter = 1 To .FoundFiles.Count
        bool = True
        For counter2 = 0 To ListTS.ListCount - 1
            If ListTS.List(counter2) = .FoundFiles(counter) Then
                bool = False
                Exit For
            End If
        Next counter2
        
        If bool Then
            ListTS.AddItem .FoundFiles(counter)
            ListTS.Selected(ListTS.ListCount - 1) = True
        End If
        
    Next counter
End With
End Sub

Thanks a lot for your help.

[Bob Phillips]

Did you try Dir as I showed the other guy?

[snb]

to make an inventory of all xls files in directory G:\OF and its subdirectories:

Sub M_snb()
   sn=split(createobject("wscript.shell").exec("cmd /c Dir ""G:\OF\*.xls"" /s /a /b").stdout.readall,vbCrLf)
  
   sheets(1).cells(1).resize(ubound(sn)+1) =application.transpose(sn)
End Sub

[Kasam]

Actually, I'm not the one who wrote this code and in fact it's the first time I read a VBA code. I tried to understand what the guy wanted to do, then I tried to do the equivalent using Dir, but I don't see how to put the files into a list like he did (I don't really know how to manipulate Lists in VBA), how I can count the files, or how I can read through a list. Could you please give me ideas, syntax, so I can reconstruct a compatible code ?
Thanks !

[Bob Phillips]

It's all in the other post. It doesn't count them, it just loops until there are no more. To put it in a listbox, replace all the lines between Else And End If with

ListTS.AddItem fs

[Kasam]

Is this ok ?

Sub searchSub(strDir As String, strSearch As String)


 Dim fs
 fs = Dir(strDir & Application.PathSeparator & "*.xl*")
    If fs <> "" Then
         
        Do While fs <> ""
            If fs = strSearch Then
                 'Skips Consolidating File
            Else
                ListTS.AddItem fs
            End If
             
            fs = Dir
        Loop
    Else
        MsgBox "There were no files found."
    End If
End sub

[GTO]

Hi Kasam,

I tacked in what you had into a userform with a correctly named listbox and it works fine for me. Have you tried it?

Option Explicit
  
Private Sub UserForm_Initialize()
  
  searchSub "E:\Tents VBA Projects\ADP Tracker", "ADP Track hours_mwsver08.xlsm"
  
End Sub
  
Private Sub searchSub(strDir As String, strSearch As String)
Dim fs As String
  
  Me.ListTS.Clear
  
  fs = Dir(strDir & Application.PathSeparator & "*.xl*")
  
  If fs <> "" Then
      
    Do While fs <> ""
      If fs = strSearch Then
        'Skips Consolidating File
      Else
        ListTS.AddItem fs
      End If
      
      fs = Dir
    Loop
  
  Else
    MsgBox "There were no files found."
  End If
  
End Sub

Mark

[Kasam]

Hi again !
Everything seems to work, but the research doesn't include subdirectories. snb, should I use your fuction directly ? Something like this :

fs=split(createobject("wscript.shell").exec("cmd /c Dir ""strDir*.xls"" /s /a /b").stdout.readall,vbCrLf) 

?
Thank you for your response

[snb]

Use the code I posted.

Replace G:\OF\ by the foldername you want to be inpected