关于 Http 请求可用的2个方法

方法1：

'参数： strMethod =(Post,Get)     strUrl=(网址)   strJson=(普通字符串或json字符串)

Public Function PostData(ByVal strMethod As String, ByVal StrUrl As String, Optional ByVal strJson As String) As String
    Dim HTTP
　　 '两者只有版本的区别，能用高版本的就用高版本的MSXML2吧，建议用MSXML2
    Set HTTP = CreateObject("MSXML2.XMLHTTP") 
    'Set HTTP = CreateObject("Microsoft.XMLHTTP")
    With HTTP
        .Open strMethod, StrUrl, True
　　　　  ''请求头类型
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        '.setRequestHeader "Content-Type", "application/json"
        .send (strJson)   '比较奇葩的 send 这个方法的参数 必须用括号括住，不然post请求会提示错误
    End With
    Do While HTTP.ReadyState <> 4
        DoEvents
    Loop
    PostData = HTTP.ResponseText
    Set HTTP = Nothing
End Function

方法2：

'从网上找的快被转烂的方法，测试可以用，留作备用吧
'PostData:
'参数:
' StrUrl --------------------接受提交的URL
'StrData   -----------------需要提交的数据，如JSON字串，或者登录字串 "user=xxx&psw=xxx"
'varAsyncX  --------------设置工作模式为同步或异步，true（异步）或false（同步），通常使用异步方式。
'CodePageX ------------对返回数据的解码编码，字符串：GB2312或UTF-8
'==================================================
Public Function PostData3(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")
    Set XMLHTTP = CreateObject("MSXML2.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)
        PostData3 = GetBody
    End If
  '------------------------------------释放空间
exitX:
  Set XMLHTTP = Nothing
  Exit Function
ERR:
  PostData3 = ""
  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