vba-访问http

关键字：vba,http,接口，中文乱码

9.1 传递参数方式

Sub httpPost()
Dim XMLHTTP
Dim result As String
Dim argumentString
argumentString = "?search_term=eggs&search_app=forums"
Set XMLHTTP = CreateObject("MSXML2.XMLHTTP.6.0")
XMLHTTP.Open "POST",_
"http://forums.egullet.org/index.php?app=core&module=search&do=search&fromMainBar=1",False
XMLHTTP.setRequestHeader "User-Agent","Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0)"
XMLHTTP.setRequestHeader "Content-type","application/x-www-form-urlencoded"
XMLHTTP.send argumentString
result = XMLHTTP.responsetext
Set XMLHTTP = Nothing
End Sub

9.2 header设置值方式
Function HttpPost(Url As String) As String

Dim client As String

On Error GoTo er
Dim XMLHTTP As Object

XMLHTTP.send
'XMLHTTP.send UTF8EncodeURI(PostMsg)

Do While XMLHTTP.ReadyState <> 4
DoEvents
Loop

'如果把下面一行(以及后面的End IF)的注释去除，即设置为仅当返回码是200时才返回页面内容

If XMLHTTP.Status = 200 Then
HttpPost = XMLHTTP.ResponseText
MsgBox HttpPost
Else
HttpPost = ""
MsgBox "失败"
End If

Exit Function
er:
MsgBox "发送POST请求失败！", , "提示"
End Function

调用方式：
Sub 调用接口()

Dim Url As String

Url = "http://localhost:8080/vba_http01/login"
HttpPost (Url)

End Sub

后端处理方式
protected void doGet(javax.servlet.http.HttpServletRequest request, javax.servlet.http.HttpServletResponse response) throws javax.servlet.ServletException, IOException {
System.out.println("收到响应了");

String json = "{\"key\":\"value\" }";

String token= request.getHeader("token") + "" ;
System.out.println(token);
response.getWriter().write(json);

// request.getRequestDispatcher("home.jsp").forward(request,response);
}
9.3 解决中文乱码问题
在post中传输中文，会出现乱码。此时需要用函数转换为urlencode。
UTF8EncodeURI 函数不需要修改，使用即可。
Function UTF8EncodeURI(szInput)
Dim wch, uch, szRet
Dim x
Dim nAsc, nAsc2, nAsc3
If szInput = "" Then
UTF8EncodeURI = szInput
Exit Function
End If
For x = 1 To Len(szInput)
wch = Mid(szInput, x, 1)
nAsc = AscW(wch)
If nAsc < 0 Then nAsc = nAsc + 65536
If (nAsc And &HFF80) = 0 Then
szRet = szRet & wch
Else
If (nAsc And &HF000) = 0 Then
uch = "%" & Hex(((nAsc \ 2 ^ 6)) Or &HC0) & Hex(nAsc And &H3F Or &H80)
szRet = szRet & uch
Else
uch = "%" & Hex((nAsc \ 2 ^ 12) Or &HE0) & "%" & _
Hex((nAsc \ 2 ^ 6) And &H3F Or &H80) & "%" & _
Hex(nAsc And &H3F Or &H80)
szRet = szRet & uch
End If
End If
Next
UTF8EncodeURI = szRet
End Function

使用：
Function HttpPost_信息(Url As String, token22 As String, projectCompany As String, guquanException_Dict As Variant) As String

Dim result As String
result = ""

Dim client As String

On Error GoTo er
Dim XMLHTTP As Object

Set XMLHTTP = CreateObject("Msxml2.XMLHTTP")

If Not IsObject(XMLHTTP) Then
Set XMLHTTP = CreateObject("Microsoft.XMLHTTP")
If Not IsObject(XMLHTTP) Then Exit Function
End If

XMLHTTP.Open "POST", Url, False
XMLHTTP.setRequestHeader "CONTENT-TYPE", "application/x-www-form-urlencoded;charset=utf-8"

XMLHTTP.setRequestHeader "token", "" & token22 & ""
XMLHTTP.setRequestHeader "client", "1024"
XMLHTTP.setRequestHeader "enterpriseName2222", "9999我是中文"

' 准备参数
argumentString = "enterpriseName=" & projectCompany

abcd = UTF8EncodeURI(argumentString)

XMLHTTP.send abcd

' XMLHTTP.send (argumentString)

Do While XMLHTTP.ReadyState <> 4
DoEvents
Loop

'如果把下面一行(以及后面的End IF)的注释去除，即设置为仅当返回码是200时才返回页面内容

If XMLHTTP.Status = 200 Then

HttpPost_信息 = XMLHTTP.ResponseText

GoTo success
Else
HttpPost = ""
MsgBox "失败"
End If