Want to win a PS4? Go Premium and enter to win our High-Tech Treats giveaway. Enter to Win

x
?
Solved

FileSearch Function Gone in Access 2007/2010

Posted on 2010-09-01
4
Medium Priority
?
1,100 Views
Last Modified: 2012-05-10
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

Open in new window

0
Comment
Question by:jasonhebert
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
4 Comments
 
LVL 25

Assisted Solution

by:jrb1
jrb1 earned 1000 total points
ID: 33578926
Here are some alternatives.  Lots of code samples.

http://allenbrowne.com/ser-59.html
http://advisor.com/doc/16279
0
 
LVL 65

Accepted Solution

by:
rockiroads earned 1000 total points
ID: 33579149
filesearch has been removed so the alternative is to use filesystemobject or the dir command as you stated
this is the suggestion from ms also http://support.microsoft.com/kb/935402 which confirms the removal of filesearch
the ms link also provides links with examples to the 2 alternatives
0
 
LVL 53

Expert Comment

by:Dhaest
ID: 34049741
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.
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
Explore the ways to Unlock VBA Project Password Excel 2010 & 2013 documents. Go through the article and perform the steps carefully to remove VBA Excel .xls file.
With the power of JIRA, there's an unlimited number of ways you can customize it, use it and benefit from it. With that in mind, there's bound to be things that I wasn't able to cover in this course. With this summary we'll look at some places to go…
Simple Linear Regression

609 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question