I was given the code below and with a few simple modifications almost all works well. The process takes a template csv file, converts the file to base64 (this is required by the recipient server) and uploads via a soap call. The response is then returned in an xml file in base64. There is a base64decode function but I don't know how to invoke this code and create a comma delimited file I can work with.
Public Function CSVRate()
Dim sUrl As String
Dim sEnv As String
Dim xmlhtp As New MSXML2.xmlhttp
Dim xmlElement As MSXML2.IXMLDOMElement
Dim XDoc As MSXML2.DOMDocument
Dim xmlDoc As New DOMDocument
Dim myFile As String
Dim strData As String
Dim ResponseText As String
'read file as binary. Need to retain the linefeed carriage return characters
Text = bin2var("C:\Users\K\Desktop\LTLRSRequest.csv")
'Call encode procedure
strData = encodeBase64(StrConv(Text, vbFromUnicode))
Debug.Print strData
sUrl = "https://applications.smc3.com/AdminManager/services/RateWareXL"
sEnv = "<?xml version='1.0' encoding='utf-8'?>"
sEnv = sEnv & "<soapenv:Envelope xmlns:soapenv='http://schemas.xmlsoap.org/soap/envelope/' xmlns:web='http://webservices.smc.com'>"
sEnv = sEnv & " <soapenv:Header>"
sEnv = sEnv & " <web:AuthenticationToken>"
sEnv = sEnv & " <web:licenseKey>redacted</web:licenseKey>"
sEnv = sEnv & " <webassword>redacted</webassword>"
sEnv = sEnv & " <web:username>redacted</web:username>"
sEnv = sEnv & " </web:AuthenticationToken>"
sEnv = sEnv & " </soapenv:Header>"
sEnv = sEnv & " <soapenv:Body>"
sEnv = sEnv & " <web:LTLRateShipmentMultipleOpt>"
sEnv = sEnv & " <web:LTLRateShipmentMultipleOptDelimitedRequest> " & strData & "</web:LTLRateShipmentMultipleOptDelimitedRequest>"
sEnv = sEnv & " </web:LTLRateShipmentMultipleOpt>"
sEnv = sEnv & " </soapenv:Body>"
sEnv = sEnv & "</soapenv:Envelope>"
With xmlhtp
.Open "post", sUrl, False
.setRequestHeader "Host", "http://demo.smc3.com/AdminManager/services/RateWareXL"
.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
.setRequestHeader "soapAction", "http://webservices.smc.com/RateWareXLPortType/LTLRateShipmentMultipleOptRequest"
.send sEnv
xmlDoc.LoadXML .ResponseText
'Save response to xml file for importing or whatever
xmlDoc.Save "C:\Users\K\Desktop\LTLRSResponse.xml"
End With
End Function
Function bin2var(filename As String) As String
Dim f As Integer
f = FreeFile()
Open filename For Binary Access Read Lock Write As #f
bin2var = Space(FileLen(filename))
Get #f, , bin2var
Close #f
End Function
Public Function encodeBase64(ByRef arrData() As Byte) As String
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
' help from MSXML
Set objXML = New MSXML2.DOMDocument
' byte array to base64
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.nodeTypedValue = arrData
Debug.Print objNode.nodeValue
Debug.Print objNode.BaseName
Debug.Print objNode.DataType
Debug.Print objNode.Text
Debug.Print objNode.nodeTypedValue
Debug.Print objNode.nodeName
Debug.Print objNode.nodeTypeString
Debug.Print objNode.nodeValue
encodeBase64 = objNode.Text
'optional to replace line breaks
encodeBase64 = Replace(objNode.Text, vbLf, "")
Set objNode = Nothing
Set objXML = Nothing
End Function
Public Function decodeBase64(ByVal strData As String) As Byte()
Dim objXML As MSXML2.DOMDocument
Dim objNode As MSXML2.IXMLDOMElement
Set objXML = New MSXML2.DOMDocument
Set objNode = objXML.createElement("b64")
objNode.DataType = "bin.base64"
objNode.Text = arrData
decodeBase64 = objNode.Text
Set objNode = Nothing
Set objXML = Nothing
End Function