criteria type mismatch on xml append

TIbbs

Registered User.
Local time
Today, 15:31
Joined
Jun 3, 2008
Messages
60
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.

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:
I figured it out just needed a few changes in the code.

Dim varOrder As String

'Set current orderNo
varOrder = POPRS.Fields("OrderNo").Value

POPItemsSQL = "SELECT tblPOPItem.* " & _
"FROM tblPOPItem LEFT OUTER JOIN tblStock " & _
"ON tblPOPItem.StockID = tblStock.ID " & _
"WHERE tblPOPItem.[OrderNo] = ' " & varOrder & " ';"
Now it works perfectly :p.
 

Users who are viewing this thread

Back
Top Bottom