SOAP - Using Excel as a Client

From PeformIQ Upgrade
Jump to navigation Jump to search

Step 1

Open up a new worksheet and select Tools - Macro \- Visual Basic Editor

Step 2

Select Tools - References and Tick Microsoft MSXML as shown below.

ExcelReferences.gif

Step 3

Double Click on This Workbook and Cut and paste the following code into the VB Editor. 


Private Function submitManifestForDespatch(URL As String, Username As String, Password As String, XML As String) As String
    Dim objXMLHTTP As New MSXML2.XMLHTTP
    Dim Request As String
   
    On Error GoTo ErrorHandler
   
    objXMLHTTP.Open "POST", URL, False
    objXMLHTTP.setRequestHeader "SOAPAction", "'http://tempuri.org/getXML"
    objXMLHTTP.setRequestHeader "Content-Type", "text/xml"
    objXMLHTTP.setRequestHeader "Authorization", "Basic " & Base64Encode(Username & ":" & Password)
    Request = Request & "<?xml version=""1.0"" encoding=""utf-8""?><soap:Envelope xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"" "
    Request = Request & " xmlns:soapenc=""http://schemas.xmlsoap.org/soap/encoding/"" "
    Request = Request & " xmlns:tns=""http://www.auspost.com.au/eParcel"" "
    Request = Request & " xmlns:types=""http://www.auspost.com.au/eParcel/encodedTypes"" "
    Request = Request & " xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" "
    Request = Request & " xmlns:xsd=""http://www.w3.org/2001/XMLSchema"">"
    Request = Request & "<soap:Body soap:encodingStyle=""http://schemas.xmlsoap.org/soap/encoding/"">"
    Request = Request & "<tns:submitManifestForDespatch>"
    Request = Request & "<string xsi:type=""xsd:string"">"
    Request = Request & XML
    Request = Request & "</string>"
    Request = Request & "</tns:submitManifestForDespatch></soap:Body></soap:Envelope>"
   
    objXMLHTTP.send Request
   
    submitManifestForDespatch = objXMLHTTP.responseText
   
    Exit Function
ErrorHandler:
    submitManifestForDespatch = Err.Description
End Function

Private Sub TestSOAPServer()
    Dim URL As String
    Dim Username As String
    Dim Password As String
    Dim XML As String
   
    URL = "https://test603a.auspost.com.au/despatchManifest/DespatchManifestWS?WSDL"
    Username = "soaptest"
    Password = "password"
    'Note That that all XML tags have been encoded\!\!\!\!
    XML = XML & "<PCMS xmlns=""http://www.auspost.com.au/xml/pcms"">"
    XML = XML & "<SendPCMSManifest><header><TransactionDateTime>2007-07-04T11:03:43.0Z</TransactionDateTime"
    XML = XML & "><TransactionId>7119</TransactionId><TransactionSequence>0</TransactionSequence>"
    XML = XML & "<ApplicationId>MERCHANT</ApplicationId></header><body><PCMSManifest><"
    XML = XML & "MerchantLocationId>AWV</MerchantLocationId><ManifestNumber>7119</ManifestNumber><"
    XML = XML & "DateSubmitted>2007-07-04T11:03:43.0Z</DateSubmitted><DateLodged>2007-07-04T11:03:43.0Z</"
    XML = XML & "DateLodged><PCMSConsignment><ConsignmentNumber>AWV0038240</ConsignmentNumber><"
    XML = XML & "ChargeCode>S2</ChargeCode><InternalChargebackAccount>8830728</InternalChargebackAccount><"
    XML = XML & "ReferenceNo1> 1378828</ReferenceNo1><ReferenceNo2>3768094</ReferenceNo2><DeliveryName>"
    XML = XML & "PHIL STATHAM</DeliveryName><DeliveryAddressLine1>PO BOX 53 CIVIC SQUARE</DeliveryAddressLine1><"
    XML = XML & "DeliverySuburb>CIVIC SQUARE PO Boxes</DeliverySuburb><DeliveryStateCode>ACT</DeliveryStateCode><"
    XML = XML & "DeliveryPostcode>2608</DeliveryPostcode><DeliveryCountryCode>AU</DeliveryCountryCode><"
    XML = XML & "IsInternationalDelivery>false</IsInternationalDelivery><ReturnName>MYER PLACE WAREHOUSE</"
    XML = XML & "ReturnName><ReturnAddressLine1>FUNTASTIC LTD 3 MYER PLACE</ReturnAddressLine1><"
    XML = XML & "ReturnSuburb>ROWVILLE</ReturnSuburb><ReturnStateCode>VIC</ReturnStateCode><"
    XML = XML & "ReturnPostcode>3178</ReturnPostcode><ReturnCountryCode>AU</ReturnCountryCode><"
    XML = XML & "ExpectedDespatchDate>2007-07-04T11:03:43.0Z</ExpectedDespatchDate><"
    XML = XML & "CreatedDateTime>2007-07-04T11:03:43.0Z</CreatedDateTime><PostChargeToAccount>8830728</"
    XML = XML & "PostChargeToAccount><IsSignatureRequired>Y</IsSignatureRequired><DeliverPartConsignment>Y</"
    XML = XML & "DeliverPartConsignment><ContainsDangerousGoods>false</ContainsDangerousGoods><"
    XML = XML & "PCMSDomesticArticle><ArticleNumber>00393184990120637054</ArticleNumber><"
    XML = XML & "BarcodeArticleNumber>00393184990120637054</BarcodeArticleNumber><Length>25</"
    XML = XML & "Length><Width>19</Width><Height>16</Height><ActualWeight>0.01</"
    XML = XML & "ActualWeight><ArticleDescription>Carton/Corrugated or Solid</ArticleDescription><"
    XML = XML & "IsTransitCoverRequired>N</IsTransitCoverRequired><ContentsItem /></PCMSDomesticArticle></"
    XML = XML & "PCMSConsignment></PCMSManifest></body></SendPCMSManifest></PCMS>"
    Debug.Print submitManifestForDespatch(URL, Username, Password, XML)
   
End Sub

Private Sub Workbook_Open()
    On Error GoTo ErrorHandler
    Dim xmlResult
    Dim soapClient As New MSSOAPLib.soapClient
   
   
    TestSOAPServer
   
    Exit Sub
   
ErrorHandler:
    Debug.Print Err.Description
End Sub

Private Function Base64Encode(inData)
    'ripped from: 'http://www.pstruh.cz/tips/detpg_Base64Encode.htm
    'rfc1521
    '2001 Antonin Foller, PSTRUH Software, [http://pstruh.cz]
    Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
    Dim sOut, I
 
    'For each group of 3 bytes
    For I = 1 To Len(inData) Step 3
        Dim nGroup, pOut
       
        'Create one long from this 3 bytes.
        nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
        &H100 * MyASC(Mid(inData, I + 1, 1)) + _
        MyASC(Mid(inData, I + 2, 1))
       
        'Oct splits the long To 8 groups with 3 bits
        nGroup = Oct(nGroup)
       
        'Add leading zeros
        nGroup = String(8 - Len(nGroup), "0") & nGroup
       
        'Convert To base64
        pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
        Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
        Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
        Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
       
        'Add the part To OutPut string
        sOut = sOut + pOut
    Next
   
    Select Case Len(inData) Mod 3
    Case 1: '8 bit final
        sOut = Left(sOut, Len(sOut) - 2) + "=="
    Case 2: '16 bit final
        sOut = Left(sOut, Len(sOut) - 1) + "="
    End Select
   
    Base64Encode = sOut
End Function

Private Function MyASC(OneChar)
    If OneChar = "" Then MyASC = 0 Else MyASC = Asc(OneChar)
End Function
Retrieved from "https://performiq.com/kb/index.php?title=SOAP_-_Using_Excel_as_a_Client&oldid=290"