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
|