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