I am trying to add a simple sales receipt to QB 2008 Prem using Excel VBA. First I used parameter for all the fields, but after not being able to get the inserts to work i hard coded all values for SalesReceiptLine and SalesReceipt. I first looked up an existing sales receipt to ensure i have the correct field names and values. However, I am still not able to get this to work.
Is somebody else using Excel VBA to add sales receipts or invoices and got it to work? I found the various examples of how to add invoice lines. I used those examples but substituted the field names with the ones for sales receipt. Again, no luck.
I would appreciate if somebody could check my code and let me know where i am wrong.
Here is the code i use:
Sub ADOExcelQBAddNewSalesReceipt()
On Error GoTo ErrorHandler
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adUseClient = 3
Dim oConnection
Dim rsSRLine
Dim rsSRHeader
Dim sMsg As String
Dim sSQLSRLine As String
Dim sSQLSRHeader As String
Dim sErrorNumber As String
Dim lRow As Long
Set wWs = ThisWorkbook.Sheets("sheet1")
Set CnQB = CreateObject("ADODB.Connection")
Set rsSRLine = CreateObject("ADODB.Recordset")
Set rsSRHeader = CreateObject("ADODB.Recordset")
' Connect to server and get table
CnQB.Open "DSN=Quickbooks Data;OLE DB Services=-2"
'Now insert sales receipt line fields
sSQLSRLine = "INSERT INTO SalesReceiptLine " + _
"(SalesReceiptLineItemRefListID, SalesReceiptLineDesc, " + _
"SalesReceiptLineQuantity, " + _
"SalesReceiptLineRate, SalesReceiptLineAmount, " + _
"SalesReceiptLineSalesTaxCodeRefListID, " + _
"FQSaveToCache) " + _
"VALUES " + _
"('03580000-1116601469', 'Irish Breakfast 8oz', 2, 16.29, 32.58, '20000-1070222261', 1)"
'Now add sales receipt line
rsSRLine.Open sSQLSRLine, CnQB, adOpenStatic, adLockOptimistic
'Now insert sales receipt line fields
sSQLSRLine = "INSERT INTO SalesReceiptLine " + _
"(SalesReceiptLineItemRefListID, SalesReceiptLineDesc, " + _
"SalesReceiptLineQuantity, " + _
"SalesReceiptLineRate, SalesReceiptLineAmount, " + _
"SalesReceiptLineSalesTaxCodeRefListID, " + _
"FQSaveToCache) " + _
"VALUES " + _
"('1BF0001-1109688181', 'Credit Card', " + _
"0, " + _
"-32.58, -32.58, " + _
"'20000-1070222261', 1)"
'Now add sales receipt line
rsSRLine.Open sSQLSRLine, CnQB, adOpenStatic, adLockOptimistic
'Now insert sales receipt header
sSQLSRHeader = "INSERT INTO SalesReceipt " + _
"(CustomerRefListId, TxnDate, ItemSalesTaxRefListID, " + _
"Memo, IsToBePrinted, CustomerSalesTaxCodeRefListID, " + _
"FQSaveToCache) " + _
"VALUES " + _
"('8000043E-1200696397', {d'2009-02-01'}, '50002-1078841799', " + _
"'MEMO', 1, '10000-1070222261', 0)"
'Now add customer
rsSRHeader.Open sSQLSRHeader, CnQB, adOpenStatic, adLockOptimistic
' Stop application updating
Application.ScreenUpdating = False
' Tidy up
CnQB.Close
Set rsCustomer = Nothing
' Exit program
Exit Sub
ErrorHandler:
sErrorNumber = Err.Number
Select Case Err.Number
Case 3370 'Not enough components
sMsg = "QuickBooks does not have enough components on hand to build this assembly item."
MsgBox sMsg, vbOKOnly, "Trapped Error"
' Err.Clear
' Resume Next
'Case 400, 350
' msg = "Error: " & Err.Number & vbCrLf & Err.Description
' MsgBox msg, vbOKOnly, "Trapped Error"
' Err.Clear
' Resume Next
Case Else
sMsg = "Error: " & Err.Number & vbCrLf & Err.Description
MsgBox sMsg, vbOKOnly, "Untrapped Error"
' Err.Clear
' Stop
' Resume
Exit Sub
End Select
End Sub
|
