VBA中如何Post Json

[weixin_42163879]

在做一个快递的单号追踪的EXcel ，POST方式数据交换是Json ，如何提交刷机久遍历结果。

[weixin_42163879]

在线等。。。。

[赵4老师]

http://www.json.org 百度搜“VBA HTTP POST”

[jessezappy]

常用方法是使用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