SOAP - Using Excel as a Client
Revision as of 14:14, 12 September 2008 by PeterHarding (talk | contribs)
Back to SOAP
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.
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