VB调用WebService（直接Post方式）并解析返回的XML

Function TodoTaskBySOAP(postURL As String,host As String, n As Integer,FilterItem() As String,OwnerSSICID() As String ,AppID() As String ,ToDoID() As String,Title() As String,Url() As String ,ExpireDate() As String,CreateTime() As String, Action() As String ,UpdateTime() As String ,Remark1() As String,Remark2() As String,Remark3() As String) As String

On Error GoTo ErrSub
Dim oXMLHttp As Variant

Dim errcode As String
Dim errmsg As String
Dim postData As String
Dim responseText As String
Dim resStr As String
Dim sXML As String
Dim i As integer
Dim oXML As Variant
Set oXMLHttp = CreateObject("Msxml2.XMLHTTP")

Dim objNodes As Variant
Dim nodeValues As Variant

If Not IsObject(oXMLHttp) Then
Set oXMLHttp = CreateObject("Microsoft.XMLHTTP")
If Not IsObject(oXMLHttp) Then
MsgBox "缺少Msxml组件!",0 + 64,"错误"
Exit Function
End If
End If

If UBound(FilterItem) = n And UBound(OwnerSSICID)= n And UBound(AppID)=n And UBound(ToDoID)=n And UBound(Title)=n And UBound(Url)=n And UBound(ExpireDate)=n And UBound(CreateTime)=n  And UBound(Action)=n And UBound(UpdateTime)=n  And UBound(Remark1)=n And UBound(Remark2)=n And UBound(Remark3)=n Then
postData = "<?xml version=""1.0"" encoding=""utf-8""?>"
postData = postData & "<soap:Envelope xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance"" xmlns:xsd=""http://www.w3.org/2001/XMLSchema"" xmlns:soap=""http://schemas.xmlsoap.org/soap/envelope/"">"
postData = postData & "<soap:Body>"
postData = postData & "<SaveToDo xmlns=""http://webservice.iipa/"">"

postData = postData & "<n>"& n &"</n>"

postData = postData + "<FilterItem>"
For i = 0 To n -1
postData = postData &"<string>" & FilterItem(i) &"</string>"
Next
postData = postData + "</FilterItem>"

postData = postData + "<OwnerSSICID>"
For i = 0 To n -1
postData = postData &"<string>" & OwnerSSICID(i) &"</string>"
Next
postData = postData + "</OwnerSSICID>"

postData = postData + "<AppID>"
For i = 0 To n -1
postData = postData &"<int>" & AppID(i) &"</int>"
Next
postData = postData + "</AppID>"

postData = postData + "<ToDoID>"
For i = 0 To n -1
postData = postData &"<string>" & ToDoID(i) &"</string>"
Next
postData = postData + "</ToDoID>"

postData = postData + "<Title>"
For i = 0 To n -1
postData = postData &"<string>" & Title(i) &"</string>"
Next
postData = postData + "</Title>"

postData = postData + "<Url>"
For i = 0 To n -1
postData = postData &"<string>" & Url(i) &"</string>"
Next
postData = postData + "</Url>"

postData = postData + "<ExpireDate>"
For i = 0 To n -1
postData = postData &"<string>" & ExpireDate(i) &"</string>"
Next
postData = postData + "</ExpireDate>"

postData = postData + "<CreateTime>"
For i = 0 To n -1
postData = postData &"<string>" & CreateTime(i) &"</string>"
Next
postData = postData + "</CreateTime>"

postData = postData + "<Action>"
For i = 0 To n -1
postData = postData &"<int>" & Action(i) &"</int>"
Next
postData = postData + "</Action>"

postData = postData + "<UpdateTime>"
For i = 0 To n -1
postData = postData &"<string>" & UpdateTime(i) &"</string>"
Next
postData = postData + "</UpdateTime>"

postData = postData + "<Remark1>"
For i = 0 To n -1
postData = postData &"<string>" & Remark1(i) &"</string>"
Next
postData = postData + "</Remark1>"

postData = postData + "<Remark2>"
For i = 0 To n -1
postData = postData &"<string>" & Remark2(i) &"</string>"
Next
postData = postData + "</Remark2>"

postData = postData + "<Remark3>"
For i = 0 To n -1
postData = postData &"<string>" & Remark3(i) &"</string>"
Next
postData = postData + "</Remark3>"

postData = postData + "</SaveToDo>"
postData = postData + "</soap:Body>"
postData = postData + "</soap:Envelope>"

Call logInfo(postData)
Call logInfo(URLEncode(postData))

oXMLHttp.Open "Post", postURL, False
oXMLHttp.setRequestHeader "Content-Type", "text/xml; charset=utf-8"
oXMLHttp.setRequestHeader "Content-length", Len(URLEncode(postData))
oXMLHttp.setRequestHeader "Accept-Language","zh-CN"
oXMLHttp.setRequestHeader  "SOAPAction","http://webservice.iipa/SaveToDo"
oXMLHttp.setRequestHeader "Host",host
oXMLHttp.Send URLEncode(postData)

responseText = oXMLHttp.responseText

Call logInfo("返回状态：" & oXMLHttp.Status)
Call logInfo("返回字段：" + responseText)

MsgBox responseText, 0 + 64,"提示"

If oXMLHttp.Status = 200 Then
sXML = oXMLHttp.responseText
resStr = StrLeft(sXML,"</SaveToDoResult>")

Set oXML = CreateObject("Microsoft.XMLDOM")
oXML.async = False

oXML.load(oXMLHttp.responseXML)

Dim values As Variant

'Set objNodes = oXML.selectNodes("//SaveToDoResult")
Set objNodes = oXML.selectNodes("//string")

Forall objNode In objNodes
MsgBox objNode.Text
Print objNode.Text
End forall

'			MsgBox oXML.getElementsByTagName("SaveToDoResult").Length
'
'			ForAll value In oXML.documentElement.childNodes
'				Print value.nodename
'				Print value.text
'			End ForAll

Else
MsgBox "服务器返回异常！返回代码：" & oXMLHttp.Status, 0 + 16,"提示"
End If
Set oXMLHttp = Nothing

Else
Call logInfo("参数不对！" &" n = " & n &"FilterItem = " &UBound(FilterItem) & " OwnerSSICID = " & UBound(OwnerSSICID) &" AppID =  " & UBound(AppID)&" ToDoID = " & UBound(ToDoID) &" Title = " & UBound(Title) &" Url = " & UBound(Url) & " ExpireDate = " & UBound(ExpireDate)&" CreateTime = " & UBound(CreateTime) & " Action = " & UBound(Action)&" UpdateTime = " & UBound(UpdateTime)&" Remark1 = " &UBound(Remark1)&" Remark2 = " & UBound(Remark2)&" Remark3 = " & UBound(Remark3))
End If

ErrExit:
Exit Function
ErrSub:
MsgBox "服务器异常！"& Err & " " & Error  , 0 + 16 , "提示"
Resume ErrExit
End Function