I am trying to append to my XML file but I keep getting an error message saying "data type mismatch in criteria expression.
I think the error is somewhere within my sql string for POPItemsSQL, but I keep on getting the same error message every time.
varOrder is a variant that holds a order number as a text string. Any ideas on where I am going wrong?
This code loades the file and appends supplier data, purchase order processing and purchase order items.
I need to link the OrderNo of the PurchaseOrderItems table to the OrderNo of the PurchaseOrder table.
here is the appendfiled function below
I think the error is somewhere within my sql string for POPItemsSQL, but I keep on getting the same error message every time.
varOrder is a variant that holds a order number as a text string. Any ideas on where I am going wrong?
This code loades the file and appends supplier data, purchase order processing and purchase order items.
I need to link the OrderNo of the PurchaseOrderItems table to the OrderNo of the PurchaseOrder table.
Code:
Private Sub AppendPOP()
On Error GoTo Err_AppendPOP
Dim POPNode, SupplierNode As IXMLDOMNode
Dim Supplier, POPOrder, POPBilling, POPDelivery, Item, POPItems, POPCarriage As IXMLDOMElement
Dim cnn As ADODB.Connection
Dim POPRS, POPItemsRS, SupplierRS As ADODB.Recordset
Dim POPSQL, POPItemsSQL, sSQL, SupplierSQL As String
Dim varOrder As Variant
Set XMLDoc = New MSXML2.DOMDocument40
XMLDoc.preserveWhiteSpace = False
XMLDoc.async = False
XMLDoc.resolveExternals = True
XMLDoc.Load XMLPath
Set SupplierNode = XMLDoc.selectSingleNode("Company/Suppliers")
Set POPNode = XMLDoc.selectSingleNode("Company/PurchaseOrders")
Set cnn = CurrentProject.Connection
SupplierSQL = "SELECT DISTINCT tblSupplier.* FROM tblSupplier INNER JOIN tblPOPOrders ON tblPOPOrders.SupplierID=tblSupplier.ID WHERE (((tblPOPOrders.Posted)=False));"
Set SupplierRS = New ADODB.Recordset
SupplierRS.CursorType = adOpenStatic
SupplierRS.LockType = adLockOptimistic
SupplierRS.Open SupplierSQL, cnn, adCmdText
' Loop through Supplier records
Do While Not SupplierRS.EOF
'Create Supplier and attach subnodes
Set Supplier = XMLDoc.createElement("Supplier")
AppendField Supplier, "Id", SupplierRS("ID"), XMLDoc
AppendField Supplier, "CompanyName", SupplierRS("Name"), XMLDoc
AppendField Supplier, "AccountReference", SupplierRS("AccountRef"), XMLDoc
SupplierRS.MoveNext
Loop
SupplierRS.Close
Set SupplierRS = Nothing
SupplierNode.appendChild Supplier
POPSQL = "SELECT *,tblPOPOrders.OrderNo AS OrderNo FROM tblPOPOrders INNER JOIN tblSupplier ON tblPOPOrders.SupplierId=tblSupplier.ID WHERE (((tblPOPOrders.Posted)=False));"
Set POPRS = New ADODB.Recordset
POPRS.CursorType = adOpenStatic
POPRS.LockType = adLockOptimistic
POPRS.Open POPSQL, cnn, adCmdText
'Set current orderNo
varOrder = POPRS("OrderNo")
' Loop through Sales Order records
Do While Not POPRS.EOF
'Create Purchase Order and attach subnodes
Set POPOrder = XMLDoc.createElement("PurchaseOrder")
AppendField POPOrder, "Id", varOrder, XMLDoc
AppendField POPOrder, "SupplierId", POPRS("SupplierId"), XMLDoc
AppendField POPOrder, "PurchaseOrderNumber", POPRS("OrderNo"), XMLDoc
AppendField POPOrder, "Notes1", POPRS("Notes"), XMLDoc
AppendField POPOrder, "Notes2", Null, XMLDoc
AppendField POPOrder, "Notes3", Null, XMLDoc
AppendField POPOrder, "Currency", POPRS("Currency"), XMLDoc
AppendField POPOrder, "AccountReference", POPRS("AccountRef"), XMLDoc
AppendField POPOrder, "PurchaseOrderDate", XSDDate(POPRS("OrderDate")), XMLDoc 'Date needs to be in function XSDDate format
' Create Purchase Address node
Set POPBilling = XMLDoc.createElement("PurchaseOrderAddress")
POPOrder.appendChild POPBilling
' Create Purchase Delivery Address node
Set POPDelivery = XMLDoc.createElement("PurchaseOrderDeliveryAddress")
POPOrder.appendChild POPDelivery
' Create Purchase Order Items node and attach subnodes
Set POPItems = XMLDoc.createElement("PurchaseOrderItems")
' Create POPOrderItems SQL
POPItemsSQL = "SELECT tblPOPItem.* " & _
"FROM tblPOPItem LEFT OUTER JOIN tblStock ON tblPOPItem.StockID = tblStock.ID " & _
"WHERE OrderNo = " & varOrder & ";"
Set POPItemsRS = New ADODB.Recordset
POPItemsRS.CursorType = adOpenStatic
POPItemsRS.LockType = adLockOptimistic
POPItemsRS.Open POPItemsSQL, cnn, adCmdText
' Loop through Order Items
Do While Not POPItemsRS.EOF
Set Item = XMLDoc.createElement("Item")
AppendField Item, "Sku", POPItemsRS("SKU"), XMLDoc
AppendField Item, "Name", POPItemsRS("Name"), XMLDoc
AppendField Item, "Description", POPItemsRS("Description"), XMLDoc
AppendField Item, "QtyOrdered", POPItemsRS("QtyOrdered"), XMLDoc
AppendField Item, "UnitPrice", POPItemsRS("UnitPrice"), XMLDoc
AppendField Item, "TaxRate", 0, XMLDoc
AppendField Item, "TotalNet", 0, XMLDoc
POPItems.appendChild Item
POPItemsRS.MoveNext
Loop
POPItemsRS.Close
Set POPItemsRS = Nothing
POPOrder.appendChild POPItems
Set POPCarriage = XMLDoc.createElement("Carriage")
AppendField POPCarriage, "QtyOrdered", 0, XMLDoc
AppendField POPCarriage, "UnitPrice", 0, XMLDoc
AppendField POPCarriage, "TotalNet", 0, XMLDoc
AppendField POPCarriage, "TotalTax", 0, XMLDoc
AppendField POPCarriage, "TaxCode", 9, XMLDoc
POPOrder.appendChild POPCarriage
AppendField POPOrder, "TakenBy", POPRS("TakenBy"), XMLDoc
POPNode.appendChild POPOrder
POPRS.MoveNext
Loop
POPRS.Close
Set POPRS = Nothing
' Close Connection to database
Set cnn = Nothing
XMLDoc.Save XMLPath
sSQL = "UPDATE tblPOPOrders SET tblPOPOrders.PostedDate = Date(), tblPOPOrders.Posted = True;"
DoCmd.RunSQL sSQL
MsgBox "Done! POP records appended to file"
'Error Messages
Exit_AppendPOP:
Exit Sub
Err_AppendPOP:
MsgBox Err.Description
Resume Exit_AppendPOP
End Sub
here is the appendfiled function below
Function AppendField(parent, objname, objvalue, DocXml)
Dim child
Set child = DocXml.createElement(objname)
If (IsNull(objvalue)) Then
child.Text = ""
ElseIf (objvalue = "False" Or objvalue = "True") Then
child.Text = LCase(objvalue)
Else
child.Text = CStr(objvalue)
End If
parent.appendChild (child)
End Function
Last edited: