Hi zemp. I can't seem to set up the DBlink properly - get an automation error on Set mDBLinkCmpRW = OpenDBLink(DBLINK_COMPANY, DBLINK_FLG_READWRITE)
If it helps, here's my code:
Sub ExportClients()
Dim connStewardship As New ADODB.Connection
Dim rsClients As New Recordset
Dim accSession As New AccpacCOMAPI.AccpacSession
On Error GoTo ACCPACErrorHandler
accSession.Init "", "AS", "AS1000", "52A"
accSession.Open "ADMIN", "TEST", "TSTDAT", Date, 0, ""
Dim mDBLinkCmpRW As AccpacCOMAPI.AccpacDBLink
Set mDBLinkCmpRW = OpenDBLink(DBLINK_COMPANY, DBLINK_FLG_READWRITE)
Dim ARCUSTOMER1 As AccpacCOMAPI.AccpacView
Dim ARCUSTOMER1Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "AR0024", ARCUSTOMER1
Set ARCUSTOMER1Fields = ARCUSTOMER1.Fields
Dim ARCUSTSTAT2 As AccpacCOMAPI.AccpacView
Dim ARCUSTSTAT2Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "AR0022", ARCUSTSTAT2
Set ARCUSTSTAT2Fields = ARCUSTSTAT2.Fields
Dim ARCUSTCMT3 As AccpacCOMAPI.AccpacView
Dim ARCUSTCMT3Fields As AccpacCOMAPI.AccpacViewFields
mDBLinkCmpRW.OpenView "AR0021", ARCUSTCMT3
Set ARCUSTCMT3Fields = ARCUSTCMT3.Fields
connStewardship.Open ConnectionString:="DSN=Fred", userid:="wilma", Password:="barney"
Set rsClients.ActiveConnection = connStewardship
rsClients.CursorLocation = adUseClient
rsClients.Source = "select company_id, company_name, address1, address2, address3, city, province, postal_code, country, phone_number, fax_number from companies"
rsClients.Open
If rsClients.RecordCount > 0 Then
rsClients.MoveFirst
Do While Not rsClients.EOF
ARCUSTOMER1Fields("IDCUST").Value = "FRED" + CStr(rsClients.Fields.Item(0).Value)
ARCUSTSTAT2.Init
ARCUSTSTAT2Fields("IDCUST").PutWithoutVerification ("FRED" + CStr(rsClients.Fields.Item(0).Value)) ' Customer Number
ARCUSTSTAT2Fields("CNTYR").PutWithoutVerification ("2004") ' Year
ARCUSTSTAT2Fields("CNTPERD").Value = "06" ' Period
ARCUSTCMT3.Init
ARCUSTCMT3Fields("IDCUST").PutWithoutVerification ("FRED" + CStr(rsClients.Fields.Item(0).Value)) ' Customer Number
ARCUSTCMT3.Browse "(IDCUST = ""FRED" + CStr(rsClients.Fields.Item(0).Value) + """)", 1
ARCUSTOMER1Fields("NAMECUST").Value = rsClients.Fields.Item(1).Value ' Customer Name
ARCUSTOMER1Fields("IDGRP").Value = "CSR" ' Group Code
ARCUSTOMER1Fields("TEXTSNAM").Value = Left(rsClients.Fields.Item(1).Value, 15) ' Short Name
ARCUSTOMER1Fields("CODETAXGRP").Value = "GPST" ' Tax Group
ARCUSTOMER1Fields("TEXTSTRE1").PutWithoutVerification (rsClients.Fields.Item(2).Value) ' Address Line 1
ARCUSTOMER1Fields("TEXTSTRE2").PutWithoutVerification (rsClients.Fields.Item(3).Value) ' Address Line 2
ARCUSTOMER1Fields("TEXTSTRE3").PutWithoutVerification (rsClients.Fields.Item(4).Value) ' Address Line 3
ARCUSTOMER1Fields("NAMECITY").PutWithoutVerification (rsClients.Fields.Item(5).Value) ' City
ARCUSTOMER1Fields("CODESTTE").PutWithoutVerification (rsClients.Fields.Item(6).Value) ' State/Prov.
ARCUSTOMER1Fields("CODEPSTL").PutWithoutVerification (rsClients.Fields.Item(7).Value) ' Zip/Postal Code
ARCUSTOMER1Fields("CODECTRY").PutWithoutVerification (rsClients.Fields.Item(8).Value) ' Country
ARCUSTOMER1Fields("TEXTPHON1").PutWithoutVerification (rsClients.Fields.Item(9).Value) ' Phone Number
ARCUSTOMER1Fields("TEXTPHON2").PutWithoutVerification (rsClients.Fields.Item(10).Value) ' Fax Number
'ARCUSTOMER1Fields("EMAIL2").PutWithoutVerification (rsClients.Fields.Item(11).Value) ' E-mail
ARCUSTOMER1.Insert
rsClients.MoveNext
Loop
End If
rsClients.Close
connStewardship.Close
Set ARCUSTCMT3 = Nothing
Set ARCUSTSTAT2 = Nothing
Set ARCUSTOMER1 = Nothing
Exit Sub
ACCPACErrorHandler:
Dim lCount As Long
Dim lIndex As Long
If Errors Is Nothing Then
MsgBox Err.Description
MsgBox "VBA Macros cannot run where Accpac is deployed as a Web Server"
Else
lCount = Errors.Count
If lCount = 0 Then
MsgBox Err.Description
Else
For lIndex = 0 To lCount - 1
MsgBox Errors.Item(lIndex)
Next
Errors.Clear
End If
Resume Next
End If
End Sub