Application.Filesearch not working

[raj2004141]

Dear Colleagues
Im not a VBA expert and require help please. The Code below nolonger works and I need a fix desperately fast. I have had a look around but cant even seem to get the fix working.
Please help, the code is below:


Private Sub Imp_Sales_Btn_Click()
Dim fileDlg As Object, sTextFiles As ADODB.Recordset, sRegistry As ADODB.Recordset
Dim txtfile As Object, fName As String, fTxt As Object, fline As String, fDate As Date
Dim I As Integer, J As Integer, inStart As Integer, Pos As Integer, Flds(4) As String
Dim strSQL As String
If Not FISQueries.EmptyTable("SalesTextFiles") Then
Exit Sub
End If
Set FSys = CreateObject("Scripting.FileSystemObject")
Set fileDlg = Application.FileSearch
With fileDlg
.NewSearch
.LookIn = "C:\Users\rsharma\Desktop\Source\Raj\Sales"
.SearchSubFolders = False
.filename = "*.csv"
.MatchTextExactly = True
If .Execute() > 0 Then
For I = 1 To .foundfiles.Count
Set txtfile = FSys.GetFile(.foundfiles(I))
fName = FSys.GetFileName(.foundfiles(I))

Set fTxt = FSys.OpenTextFile(.foundfiles(I), 1, TriStateFalse)
fline = fTxt.ReadLine

inStart = 1
For J = 0 To 4
Pos = InStr(inStart, fline, ",")
If Pos > inStart Then
Flds(J) = Mid$(fline, inStart, Pos - inStart)
inStart = Pos + 1
End If
Next J
If Not IsNull(Flds(4)) Then
If IsDate(Flds(4)) Then
fDate = CDate(Flds(4))
End If
End If
strSQL = "insert SalesTextFiles([Name],Full_Name,Sales_Date) values('" & fName & "','" & .foundfiles(I) & "','" & FISQueries.SQLDate(fDate) & "')"
CurrentProject.Connection.Execute strSQL
Set textFile = Nothing
Set fTxt = Nothing
Next I
Else
MsgBox "There were no files found."
End If
End With

Set fileDlg = Nothing
DoCmd.OpenForm "Sales_Import_Form", acNormal, , , , acDialog
End Sub

 

[Estuardo]

G'd evening,
The Application.FileSearch no longer exist in 2k7/2k10/2k13 the most popular workaround is here
G'd luck