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

解决方案 »

  1.   

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

  2.   

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