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 Application.FileSearch 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

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

[Bob Phillips]

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

[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