VBScript XML Quote Request Example (.vbs)

This sample shows how to send an XML quote request to Jet Delivery’s API using VBScript and MSXML

Paste the following into your project:

Option Explicit

Sub xmlGetQuote()
  Dim objXMLhttp, objXMLfileSnd, objXMLfileRcv
  Dim strXMLsend, strXMLreply

  Set objXMLhttp    = CreateObject("MSXML2.XMLHTTP")
  Set objXMLfileSnd = CreateObject("MSXML2.DOMDocument.6.0")
  Set objXMLfileRcv = CreateObject("MSXML2.DOMDocument.6.0")

  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>" & _
    "<Deliverdate>" & xmlDate(Date) & "</Deliverdate>" & _
    "</Quote>" & _
    "</XMLST>"

  objXMLfileSnd.async = False
  If Not objXMLfileSnd.loadXML(strXMLsend) Then
    MsgBox "XML parse error: " & objXMLfileSnd.parseError.reason
    Exit Sub
  End If

  objXMLhttp.Open "POST", "https://www.jetdelivery.com/xml/data/index.asp?action=quote", False
  objXMLhttp.setRequestHeader "Content-type", "application/xml"
  objXMLhttp.Send strXMLsend

  strXMLreply = objXMLhttp.responseText

  objXMLfileRcv.async = False
  objXMLfileRcv.loadXML strXMLreply ' ignore parse failure; still show raw reply

  MsgBox strXMLreply
End Sub

Function xmlDate(inVar)
  xmlDate = Year(inVar) & "-" & Right("0" & Month(inVar), 2) & "-" & Right("0" & Day(inVar), 2)
End Function

xmlGetQuote