在做一個快遞的單號追蹤的EXcel ，POST方式資料交換是Json ，如何提交刷機久遍歷結果。
uj5u.com熱心網友回復：
在線等。。。。uj5u.com熱心網友回復：
http://www.json.org百度搜“VBA HTTP POST”
uj5u.com熱心網友回復：
常用方法是使用Microsoft.XMLHTTP組件來進行，下面是包裝好的一個函式，PostData：
引數:
StrUrl --------------------接受提交的URL
StrData -----------------需要提交的資料，如JSON字串，或者登錄字串 "user=xxx&psw=xxx"
varAsyncX --------------設定作業模式為同步或異步，true（異步）或false（同步），通常使用異步方式。
CodePageX ------------對回傳資料的解碼編碼，字串：GB2312或UTF-8
'==================================================
Public Function PostData(ByVal StrUrl As String, ByVal StrData As String, varAsyncX As Boolean, CodePageX As String) As Variant
' On Error GoTo ERR:'ByVal DataStic As DataEnum,
Dim XMLHTTP As Object, GetBody
Dim DataS As String
Dim DataB() As Byte
Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
XMLHTTP.Open "POST", StrUrl, varAsyncX 'True
' XMLHTTP.setRequestHeader "Content-Length", Len(PostData)
XMLHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
XMLHTTP.send (StrData)
If varAsyncX Then
Do Until XMLHTTP.ReadyState = 4
DoEvents
Loop
End If
GetBody = XMLHTTP.ResponseBody
If Len(GetBody) > 1 Then
GetBody = BytesToStr(GetBody, CodePageX)
PostData = GetBody
End If
'------------------------------------釋放空間
exitX:
Set XMLHTTP = Nothing
Exit Function
ERR:
PostData = ""
Resume exitX 'Next
End Function
Public Function BytesToStr(strBody, CodeBase)
Dim objStream
Set objStream = CreateObject("Adodb.Stream")
With objStream
.Type = 1
.Mode = 3
.Open
.Write strBody
.Position = 0
.Type = 2
.Charset = CodeBase '"GB2312" '
BytesToStr = .ReadText
.Close
End With
Set objStream = Nothing
End Function
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/46917.html
標籤：VBA