<strong id="nr4sf"></strong>

<button id="nr4sf"><object id="nr4sf"></object></button>

    <rp id="nr4sf"></rp>
    <th id="nr4sf"><track id="nr4sf"></track></th>
      <s id="nr4sf"></s>
    1. <em id="nr4sf"></em>
    2. <li id="nr4sf"><acronym id="nr4sf"></acronym></li>
    3. <button id="nr4sf"></button>

      office交流網--QQ交流群號

      Access培訓群:792054000         Excel免費交流群群:686050929          Outlook交流群:221378704    

      Word交流群:218156588             PPT交流群:324131555

      VBA或VB6調用WebService(直接Post方式)并解析返回的XML

      2019-11-15 08:00:00
      zstmtony
      轉貼
      17112

      VBA或VB6調用WebService(直接Post方式)并解析返回的XML,理論上Access也是可以使用的


      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("http://SaveToDoResult")	
      			Set objNodes = oXML.selectNodes("http://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
       
      原文鏈接:https://blog.csdn.net/kangkanglou/article/details/38980691

      分享
      一级日本牲交大片束缚_玖玖资源站亚洲最大的网站_56PAO国产成视频永久_97人人操人人摸
      <strong id="nr4sf"></strong>

      <button id="nr4sf"><object id="nr4sf"></object></button>

      <rp id="nr4sf"></rp>
      <th id="nr4sf"><track id="nr4sf"></track></th>
        <s id="nr4sf"></s>
      1. <em id="nr4sf"></em>
      2. <li id="nr4sf"><acronym id="nr4sf"></acronym></li>
      3. <button id="nr4sf"></button>