Accounting systems

 
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