jasonhebert
asked on
FileSearch Function Gone in Access 2007/2010
We've starting running into issues with our Office migration on a few programs that were written inhouse. Seems FileSearch is no longer being used. Dir the only option to get around this?
Close ALL
Dim Payment(20, 4) As Variant
Set fs = Application.FileSearch
Set fso = CreateObject("Scripting.FileSystemObject")
'ArchiveDir = "\\fnbb-nas-1\invdata\pandi\"
'IntraderUPL = "\\fnbb-nas-1\invdata\pandi\" & Format(Now(), "MM-DD-YY") & ".UPL" '
'**CJD 2-14-09
ArchiveDir = "\\fnbb-nas-1\invdata\pandi\"
IntraderUPL = "\\fnbb-nas-1\invdata\pandi\" & Format(Now(), "MM-DD-YY") & ".UPL"
tablename$ = "CusipPayment"
paytablename$ = "Payment"
With fs
.LookIn = "\\fnbb-main-1\Inv\Payments\Work"
.FileName = "P and I*.*"
If .Execute > 0 Then
MySql = "delete from CUSIPPAYMENT"
myDSN = "DSN=PandI"
Set conntemp = CreateObject("adodb.connection")
conntemp.Open myDSN
Set rstemp = conntemp.Execute(MySql)
Set rstemp = Nothing
conntemp.Close
MySql = "dELETE FROM PAYMENT"
myDSN = "DSN=PandI"
Set conntemp = CreateObject("adodb.connection")
conntemp.Open myDSN
Set rstemp = conntemp.Execute(MySql)
Set rstemp = Nothing
conntemp.Close
MsgBox "There were " & .foundfiles.Count & _
" file(s) found."
cmd$ = "cmd /c type \\fnbb-main-1\inv\payments\work\P*.* > " & IntraderUPL
x = Shell(cmd$, vbMaximizedFocus)
fso.copyfile IntraderUPL, "\\fnbbbrinvw5002\imm\"
For i = 1 To .foundfiles.Count
Open .foundfiles(i) For Input As #1
While Not EOF(1)
Report$ = Input(79, #1)
If Mid$(Report$, 1, 8) = " " Then
Report$ = Mid$(Report$, 25, 55) & Input(24, #1)
End If
If Mid$(Report$, 1, 1) = "2" Then
InvAcct$ = Mid$(Report$, 30, 4)
ElseIf Mid$(Report$, 1, 1) = "3" Then
Paydate$ = Mid$(Report$, 9, 8)
RecDate$ = Mid$(Report$, 26, 8)
FunderAcct$ = Mid$(Report$, 42, 9)
Funder$ = Mid$(Report$, 52, 8)
ReportDate$ = Mid(Report$, 68, 8)
ElseIf Mid$(Report$, 1, 1) = "4" Then
Cusip$ = Mid$(Report$, 10, 9)
SecurityInfo$ = Mid$(Report$, 20, 18)
MaturityDate$ = Mid$(Report$, 48, 8)
ElseIf Mid$(Report$, 1, 1) = "5" Then
ParAmount$ = Mid$(Report$, 13, 18)
Rate1$ = Mid$(Report$, 38, 6)
CusipPayment$ = Mid$(Report$, 52, 20)
Report$ = Input(79, #1)
If Mid$(Report$, 1, 8) = " " Then
Report$ = Mid$(Report$, 25, 55) & Input(24, #1)
End If
While Mid$(Report$, 1, 1) = "A"
CusipIncrement = Mid$(Report$, 9, 1)
CusipIncrementPayment = CCur(Mid$(Report$, 52, 20))
MySql = "INSERT INTO " & tablename$ & " (PAYDATE,RECDATE,FUNDERACCT,FUNDER,REPORTDATE,CUSIP,CUSIPINCREMENT,CUSIPAMOUNT)"
MySql = MySql & "VALUES('" & Paydate$ & "','" & RecDate$ & "','" & FunderAcct$ & "','" & Funder$ & "','" & ReportDate$ & "','" & Cusip & "'," & CusipIncrement & "," & CusipIncrementPayment & ")"
myDSN = "DSN=PandI"
Set conntemp = CreateObject("adodb.connection")
conntemp.Open myDSN
Set rstemp = conntemp.Execute(MySql)
Set rstemp = Nothing
conntemp.Close
Report$ = Input(79, #1)
If Mid$(Report$, 1, 8) = " " Then
Report$ = Mid$(Report$, 25, 55) & Input(24, #1)
End If
Wend
ElseIf Mid$(Report$, 1, 1) = "7" Then
TotalPayments = CCur(Mid$(Report$, 52, 20))
Report$ = Input(79, #1)
If Mid$(Report$, 1, 8) = " " Then
Report$ = Mid$(Report$, 25, 55) & Input(24, #1)
End If
'MsgBox Report$
TempPayment = CCur(Mid$(Report$, 52, 20))
Report$ = Input(79, #1)
If Mid$(Report$, 1, 8) = " " Then
Report$ = Mid$(Report$, 25, 55) & Input(24, #1)
End If
If Mid$(Report$, 1, 1) <> "B" Then
Increment = 1
IncrementPayment = TempPayment
MySql = "INSERT INTO " & paytablename$ & " (PAYDATE,RECDATE,FUNDERACCT,FUNDER,REPORTDATE,INCREMENT,AMOUNT)"
MySql = MySql & "VALUES('" & Paydate$ & "','" & RecDate$ & "','" & FunderAcct$ & "','" & Funder$ & "','" & ReportDate$ & "'," & Increment & "," & IncrementPayment & ")"
myDSN = "DSN=PandI"
Set conntemp = CreateObject("adodb.connection")
conntemp.Open myDSN
Set rstemp = conntemp.Execute(MySql)
Set rstemp = Nothing
conntemp.Close
End If
While Not EOF(1) And Mid$(Report$, 1, 1) = "B"
Increment = CInt(Mid$(Report$, 14, 2))
IncrementPayment = CCur(Mid$(Report$, 52, 20))
MySql = "INSERT INTO " & paytablename$ & " (PAYDATE,RECDATE,FUNDERACCT,FUNDER,REPORTDATE,INCREMENT,AMOUNT)"
MySql = MySql & "VALUES('" & Paydate$ & "','" & RecDate$ & "','" & FunderAcct$ & "','" & Funder$ & "','" & ReportDate$ & "'," & Increment & "," & IncrementPayment & ")"
myDSN = "DSN=PandI"
Set conntemp = CreateObject("adodb.connection")
conntemp.Open myDSN
Set rstemp = conntemp.Execute(MySql)
Set rstemp = Nothing
conntemp.Close
Report$ = Input(79, #1)
If Mid$(Report$, 1, 8) = " " Then
Report$ = Mid$(Report$, 25, 55) & Input(24, #1)
End If
Wend
End If
Wend
Close #1
fso.copyfile .foundfiles(i), ArchiveDir
fso.deletefile .foundfiles(i)
NextFile:
Next i
'Now run the Future Items stored procedure to move warehoused items paying today into the current payments and
'to move future items into the warehouse.
MySql = "exec Future_Items"
myDSN = "DSN=PandI"
Set conntemp = CreateObject("adodb.connection")
conntemp.Open myDSN
Set rstemp = conntemp.Execute(MySql)
Set rstemp = Nothing
conntemp.Close
DoCmd.TransferText acExportFixed, "MGPI Export", "dbo_Payment Query", "\\fnbb-main-1\inv\payments\work\mgpi.txt"
fso.copyfile "\\fnbb-main-1\inv\payments\work\mgpi.txt", "\\fnbb-main-1\inv\payments\work\mgpi.dat"
fso.deletefile "\\fnbb-main-1\inv\payments\work\mgpi.txt"
DoCmd.OpenReport "Payments Report"
DoCmd.OpenReport "CUSIP Payments Report"
DoCmd.OpenReport "Future Payments Report"
MsgBox "Done"
Else
x = MsgBox("There were no files found.", vbCritical)
End If
End With
Close #1
End Sub
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
This question has been classified as abandoned and is being closed as part of the Cleanup Program. See my comment at the end of the question for more details.