Private Function getToken()

Dim xmlhttp
Dim url

Set xmlhttp = CreateObject("msxml2.xmlhttp")
With xmlhttp
url = "https://aip.baidubce.com/oauth/2.0/token?grant_type=client_credentials&client_id=xxxxxx&client_secret=xxxxx"

.Open "POST", url, False '////填网址
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send "MENU=200&code=1540&JOB=VOTE" '////填写所需send的内容
Dim p As Object, key As Variant
Set p = JSON.parse(.responseText)
getToken = p.Item("access_token")
'Text2.Text = .responseText
'MsgBox .responseText '显示POST之后网页返回的结果

End With
Set xmlhttp = Nothing

End Function

Private Function sendPic(Token As String)'发送base64 图像文件 解析反馈结果
Dim xmlhttp
Dim url
Dim p As Object

Set xmlhttp = CreateObject("msxml2.xmlhttp")
With xmlhttp

url = "https://aip.baidubce.com/rpc/2.0/ai_custom/v1/classification/xxxx?access_token=" & Token

.Open "POST", url, False '////填网址
.setRequestHeader "Content-Type", "application/json"
.send TXTImg.Text '////填写所需send的内容
Respone.Text = .responseText
Set p = JSON.parse(.responseText)

nook.Text = JSONParse("results[0].score", toString(p)) * 100  '解析Json 结果
ok.Text = JSONParse("results[1].score", toString(p)) * 100
End With
Set xmlhttp = Nothing

End Function

Public Function JSONParse(ByVal JSONPath As String, ByVal JSONString As String) As Variant
Dim JSON As Object
Set JSON = CreateObject("MSScriptControl.ScriptControl")
JSON.Language = "JScript"
JSONParse = JSON.Eval("JSON=" & JSONString & ";JSON." & JSONPath & ";")
Set JSON = Nothing
End Function