Visual Basic | Sample Code |
This sample code uses the free Microsoft MSXML 4.0 parser. You should download and install the latest version if you do not already have it installed. Notes:
|
Sub xmlGetQuote()
Dim objXMLhttp As New
MSXML2.xmlHttp
Dim objXMLfileSnd As
New MSXML2.DOMDocument
Dim objXMLfileRcv As
New MSXML2.DOMDocument
Dim strXMLsend As
String
Dim strXMLreply As
String
' Build a sample XML formatted `quote` request.
strXMLsend = "<?xml version='1.0' encoding='UTF-8' ?>" & _
"<XMLST xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'>" & _
"<RequestHeader>" & _
"<xmlsacn>44710</xmlsacn>" & _
"<xmlsuid>446546456</xmlsuid>" & _
"<xmlstrn>45hd89s87</xmlstrn>" & _
"</RequestHeader>" & _
"<Quote>" & _
"<PickupZip>90021</PickupZip>" & _
"<DeliverZip>92050</DeliverZip>" & _
"<Pieces>2</Pieces>" & _
"<Weight>50</Weight>" & _
"<ServiceType>IMMEDIATE</ServiceType>" & _
"<VehicleType>TRK</VehicleType>" & _
"<Pickupdate>" & xmlDate(Date) & "</Pickupdate>" & _
"<Pickuptime></Pickuptime>" & _
"<Deliverdate>" & xmlDate(Date) & "</Deliverdate>" & _
"<Deliverfrom></Deliverfrom>" & _
"<Deliverto></Deliverto>" & _
"</Quote>" & _
"</XMLST>"
' Validate the document using the MSXML parser.
objXMLfileSnd.loadXML strXMLsend
If objXMLfileSnd.parseError.errorCode
Then
' Do something with the error.
End If
' Send the XML message to Jet Delivery.
objXMLhttp.Open "POST", "http://rest.jetdelivery.com/xml/data/index.asp?action=quote",
False
objXMLhttp.setRequestHeader "Content-type", "application/xml"
objXMLhttp.send objXMLfileSnd
' Receive and Load the XML response from Jet Delivery.
objXMLfileRcv.async = False
loaded = objXMLfileRcv.loadXML(objXMLhttp.responseText)
strXMLreply = objXMLhttp.responseText
MsgBox ("FIRST: Click `OK` to see the response in XML format...")
MsgBox (strXMLreply)
' Parse the response.
If loaded = True Then
'#<-- Begin parsing the response.
'Sender unique identifier. #<-- Not required but
used in this example!
Set xmlstrnNode =
objXMLfileRcv.selectSingleNode("XMLST/ReplyHeader/xmlstrn")
If Not xmlstrnNode
Is Nothing Then
xmlstrn = xmlstrnNode.Text
End If
'Shipment Origin. #<-- Not required but used in
this example!
Set OriginNode =
objXMLfileRcv.selectSingleNode("XMLST/Quote/Origin")
Origin = OriginNode.Text
'Shipment Destination.
Set DestinationNode =
objXMLfileRcv.selectSingleNode("XMLST/Quote/Destination")
Destination = DestinationNode.Text
'Estimated Delivery Date.
Set EstimatedDeliveryDateNode =
objXMLfileRcv.selectSingleNode("XMLST/Quote/EstimatedDeliveryDate")
EstimatedDeliveryDate = EstimatedDeliveryDateNode.Text
'Estimated Delivery Time.
Set EstimatedDeliveryTimeNode =
objXMLfileRcv.selectSingleNode("XMLST/Quote/EstimatedDeliveryTime")
EstimatedDeliveryTime = EstimatedDeliveryTimeNode.Text
'Delivery Time Zone.
Set DeliveryTimeZoneNode =
objXMLfileRcv.selectSingleNode("XMLST/Quote/DeliveryTimeZone")
DeliveryTimeZone = DeliveryTimeZoneNode.Text
'Confirmed Service Type.
Set ServiceTypeNode =
objXMLfileRcv.selectSingleNode("XMLST/Quote/ServiceType")
ServiceType = ServiceTypeNode.Text
'Confirmed Vehicle Type.
Set VehicleTypeNode =
objXMLfileRcv.selectSingleNode("XMLST/Quote/VehicleType")
VehicleType = VehicleTypeNode.Text
'Estimated Price.
Set EstimatedPriceNode =
objXMLfileRcv.selectSingleNode("XMLST/Quote/EstimatedPrice")
EstimatedPrice = EstimatedPriceNode.Text
End If
MsgBox ("NOW!: Click `OK` to see the response after the message is parsed and we
have our varibles set.")
MsgBox ("TRNS: " & xmlstrn & vbCrLf & vbCrLf & "Origin: " & Origin & vbCrLf &
"Destin: " & Destination & vbCrLf & "E.T.A: " &
FormatDateTime(EstimatedDeliveryDate, 1) & " (at) " &
FormatDateTime(EstimatedDeliveryTime, 3) & " " & DeliveryTimeZone & vbCrLf & "sType:
" & ServiceType & vbCrLf & "vType: " & VehicleType & vbCrLf & "Price: " &
FormatCurrency(EstimatedPrice))
End Sub
Function xmlDate(inVar)
If Len(DatePart("m", inVar)) = 1
Then
If Len(DatePart("d", inVar)) = 1
Then xmlDate = DatePart("yyyy", inVar) & "-" & "0"
& DatePart("m", inVar) & "-" & "0" & DatePart("d", inVar)
Else xmlDate = DatePart("yyyy", inVar) & "-" & "0" & DatePart("m", inVar)
& "-" & DatePart("d", inVar)
Else
xmlDate = DatePart("yyyy", inVar) & "-" & DatePart("m", inVar) &
"-" & DatePart("d", inVar)
End If
End Function