Posts

Downloading XML files into access

/0 Comments/in , , /by

I use this function to download xml files from a ftp server and read the contents into an Access database.

This function deals with the FTP process. I use a licensed product component from chilkatsoft.com call chilkatftp.

Function DownloadFiles()
On Error GoTo ErrorHandler
Dim ftp As New ChilkatFtp2
Dim success As Integer
Dim n As Integer, i As Integer, rst As Recordset, fname As String
Dim tmpFTP, tmpUsername, tmpPassword, tmpRemote, tmpLocalFolder

Application.echo true, "Start FTP Download Check.." & Now()

tmpLocalFolder = "set your local folder here"
tmpFTP = "Enter you FTP Address"
tmpPassword = "Password"
tmpRemote = "Remote ftp folder"
tmpUsername = "Username"

If Right(tmpLocalFolder, 1) <> "" Then
    If Right(tmpLocalFolder, 1) = "/" Then
        tmpLocalFolder = Left(tmpLocalFolder, Len(tmpLocalFolder) - 1) & ""
    Else
        tmpLocalFolder = tmpLocalFolder & ""
    End If
End If

' Any string unlocks the component for the 1st 30-days.
success = ftp.UnlockComponent("enter_your_unlock_code")
If (success <> 1) Then
    Forms![frmFTPSettings]![txtProgress] = ftp.LastErrorText
    Exit Function
End If

Call UpProgress("Connected to Site")
ftp.Hostname = tmpFTP
ftp.UserName = tmpUsername
ftp.Password = tmpPassword

' Connect and login to the FTP server.
success = ftp.Connect()
If (success <> 1) Then
    Forms![frmFTPSettings]![txtProgress] = ftp.LastErrorText '   open form to display the error
    Exit Function
End If

' Change to the remote directory where the files are located.
' This step is only necessary if the files are not in the root directory
' of the FTP account.
success = ftp.ChangeRemoteDir(tmpRemote)
If (success <> 1) Then
    Forms![frmFTPSettings]![txtProgress] = ftp.LastErrorText
    Exit Function
End If

ftp.ListPattern = "*.xml"

'  NumFilesAndDirs contains the number of files and sub-directories
'  matching the ListPattern in the current remote directory.
'
n = ftp.NumFilesAndDirs
If (n < 0) Then
    Forms![frmFTPSettings]![txtProgress] = ftp.LastErrorText
    Exit Function
End If

Application.echo true, n & " Files downloaded "

If (n > 0) Then
    For i = 0 To n - 1
    '
        fname = ftp.GetFilename(i)

        CurrentDb.Execute ("INSERT INTO tblFilesDownloaded ( FTP_FileDownloaded, FTP_Date, FTP_Processed ) SELECT " & Chr(34) & ftp.GetFilename(i) & Chr(34) & " AS Expr1," & "#" & Now() & "#" &" AS Expr2, 0 AS Expr3")
        '  Download the file into the current working directory.
        success = ftp.GetFile(fname, tmpLocalFolder & fname)
        If (success <> 1) Then
            Forms![frmFTPSettings]![txtProgress] = ftp.LastErrorText
            Exit Function
        End If

        '  Now delete the file.
        success = ftp.DeleteRemoteFile(fname)
        If (success <> 1) Then
            Forms![frmFTPSettings]![txtProgress] = ftp.LastErrorText
            Exit Function
        End If
    '
    Next
End If
'
ftp.Disconnect
'
Exit Function
ErrorHandler:
application.echo true, "FTP - An error occurred " & Err.Number & " " & Err.Description & " At:" & Now())
Resume Next

End Function

Downloading Customer data from Intact Business Accounting

/0 Comments/in , /by

Intact Business Accounting has an SDK which is exposed for all developers and available in the system.  The following sample shows how we load the customer data into an Access database for use with our MASC Product. IF you are using Intact and have any questions leave me a comment and I will reply.


Function LoadCust()
On Error GoTo Intact_Error
Dim IntactTable As New INTACTSDKTable
Dim tmpLastRecord, r, tmpCount, tmpCompany, tmpRcode

tmpRcode = GetPref("RouteCode Field Name")

Application.Echo True, "Linking to selected Intact Company"

tmpCompany = GetPref("Intact Company")
IntactTable.CompanyDirectory (tmpCompany)
IntactTable.TableName ("CUSTS")

'Clear customers and set reference to table
CurrentDb.Execute ("Delete * from tblCustomers")
CurrentDb.Execute ("Delete * from tblCustMemo")
Dim rstCust As Recordset
Set rstCust = CurrentDb.OpenRecordset("tblCustomers")

r = IntactTable.First
tmpLastRecord = True
tmpCount = 1

Do
    rstCust.AddNew
    
    'Assign details
    rstCust!ID = IntactTable.fieldvalueasstring("CODE")
    Application.Echo True, "Adding Customer Seq:" & tmpCount & " :" & IntactTable.fieldvalueasstring("CODE")
    tmpCount = tmpCount + 1
    rstCust!CustBarcode = IntactTable.fieldvalueasstring("CODE")
    rstCust!CompanyName = IntactTable.fieldvalueasstring("NAME")
    rstCust!Add1 = IntactTable.fieldvalueasstring("ADR1")
    rstCust!Add2 = IntactTable.fieldvalueasstring("ADR2")
    rstCust!Add3 = IntactTable.fieldvalueasstring("ADR3")
    rstCust!Town = IntactTable.fieldvalueasstring("ADR4")
    rstCust!County = IntactTable.fieldvalueasstring("ADR5")
    rstCust!Phone = IntactTable.fieldvalueasstring("PHONE1")    
    rstCust!CPriceCode = IIf(Len(IntactTable.fieldvalueasstring("LISTCODE") & "") = 0, IntactTable.fieldvalueasstring("CODE"), IntactTable.fieldvalueasstring("LISTCODE"))
    'Check Delivery Address
    If Len(IntactTable.fieldvalueasstring("HOCODE") & "") > 0 Then
        rstCust!MasterAccount = IntactTable.fieldvalueasstring("HOCODE")
        rstCust!DeliveryAddress = -1
    Else
        rstCust!DeliveryAddress = 0
    End If
    rstCust!RouteCode = IntactTable.fieldvalueasstring("Repcode") 'tmpRcode) 'repcode
    'Frequency Check
    If Len(IntactTable.fieldvalueasstring("XXFREQ") & "") <> 0 And IntactTable.fieldvalueasstring("XXFREQ") <> "INVALID" Then
        rstCust!Frequency = IntactTable.fieldvalueasstring("XXFREQ")
    Else
        rstCust!Frequency = "Docket"
    End If
    'Priced Check
    If IntactTable.fieldvalueasstring("XXPRICED") = "t" Then
        rstCust!Priced = -1
    Else
        rstCust!Priced = 0
    End If
    'Active Check
    If IntactTable.fieldvalueasstring("XXACTIVE") = "t" Or IntactTable.fieldvalueasstring("XXACTIVE") = "INVALID" Or IntactTable.fieldvalueasstring("XXACTIVE") = "" Then
        rstCust!Active = -1
    Else
        rstCust!Active = 0
    End If
     
    If IntactTable.fieldvalueasstring("ForceVat") = "T" Then
        rstCust!C_Vol1 = 1
        rstCust!C_Vol2 = IntactTable.fieldvalueasstring("DefVatCode")
    Else
        rstCust!C_Vol1 = 0
    End If
    
    'Other Fields
    rstCust!InvoiceMovements = -1
    rstCust!Currency = "EUR"
    rstCust!Orders = 0
    rstCust!MESSCHK = 0
    rstCust!CustType = "RET"
    'Update record
    rstCust.Update
    
    r = IntactTable.Next
    
    If r = -90 Then tmpLastRecord = False
    
    If IntactTable.fieldvalueasstring("CODE") = "" Then
        tmpLastRecord = False
    End If
Loop While tmpLastRecord

Set rstCust = Nothing
Set IntactTable = Nothing

Exit Function

Intact_Error:
MsgBox "Intact Customer List Refresh " & Err.Number & vbCrLf & "Details " & Err.Description & vbCrLf & "Intact Msg:" & GetIntactMsg(Err.Number)

Set rstCust = Nothing
Set IntactTable = Nothing

End Function