为何VBA HTTP Post可正常运行但.NET HttpClient请求失败?
问题:VBA HTTP请求正常,但.NET HttpClient报407代理认证错误
VBA中使用MSXML2.XMLHTTP.6.0的POST请求能正常运行,但移植到.NET的HttpClient实现时,一直报错The remote server returned an error: (407) Proxy Authentication Required.。尝试添加CredentialCache后仍无法解决,不清楚该用目标URI凭据还是本地Windows凭据,两种都试过没用。
VBA 工作代码
Public Function GetScenarioData(ByVal ws As Worksheet, ByVal startTime, ByVal endTime, ByVal TagName As String) As String Dim objrequest As Object Dim strUrl As String Dim blnAsync As Boolean Dim strResponse As String Dim token As String Dim json As Object Dim body As String Dim scenCrit As Criteria Dim query As String Set objrequest = CreateObject("MSXML2.XMLHTTP.6.0") strUrl = ws.Range("url") blnAsync = True With objrequest .Open "POST", strUrl, blnAsync .setRequestHeader "Accept", "Accept: application/csv" .setRequestHeader "Content-Type", "application/x-www-form-urlencoded" .setRequestHeader "Authorization", "Basic " + Base64Encode("username" + ":" + "password") query = "q=SELECT ""tagname"",""value"" AS ""ActivePower"" FROM ""dbpart1"".""dbpart2"".""dbpart3"" WHERE TIME >= '" & startTime & "' AND time < '" & endTime & "' AND ""tagname""='" & TagName & "'" .send query 'spin wheels whilst waiting for response While objrequest.readyState <> 4 DoEvents Wend strResponse = Replace(.responseText, "\", "") strResponse = Mid(strResponse, 2, Len(strResponse) - 1) End With GetScenarioData = strResponse End Function
原始VB.NET代码(报错版本)
Public Async Function Query(ByVal content As String, ByVal userName As String, ByVal password As String) As Task(Of String) Dim authenticate As String = "" Dim requestMsg As New HttpRequestMessage(HttpMethod.Post, _client.BaseAddress) Dim response As HttpResponseMessage Dim encoded As String Try Dim encodeThis = Encoding.ASCII.GetBytes($"{userName}:{password}") encoded = Convert.ToBase64String(encodeThis) requestMsg.Headers.Authorization = New AuthenticationHeaderValue("Basic", encoded) requestMsg.Headers.Add("Accept", "application/csv") requestMsg.Content = New StringContent(content, Text.UTF8Encoding.Default, "application/x-www-form-urlencoded") response = Await _client.SendAsync(requestMsg) If (response.StatusCode = System.Net.HttpStatusCode.OK) Then Return response.Content.ReadAsStringAsync().Result End If Catch ex As Exception Throw Finally End Try End Function
修改后的VB.NET代码(仍报错)
Private _clientHandler As HttpClientHandler Private _credCache As New CredentialCache
Public Sub CreateHttpClient(ByVal target As String) Dim uri As Uri = New Uri(target) 'Only create the http client if one doesn't already exist If _client Is Nothing Then _credCache.Add(uri, "Negotiate", New NetworkCredential("username", "password")) _clientHandler = New HttpClientHandler() With {.Credentials = _credCache, .PreAuthenticate = True} _client = New HttpClient(_clientHandler) With {.Timeout = New TimeSpan(0, 0, 10)} _client.BaseAddress = uri End If End Sub Public Async Function Query(ByVal content As String, ByVal userName As String, ByVal password As String) As Task(Of String) Dim authenticate As String = "" Dim requestMsg As New HttpRequestMessage(HttpMethod.Post, _client.BaseAddress) Dim response As HttpResponseMessage Dim encoded As String Try Dim encodeThis = Encoding.ASCII.GetBytes($"{userName}:{password}") encoded = Convert.ToBase64String(encodeThis) requestMsg.Headers.Authorization = New AuthenticationHeaderValue("Basic", encoded) requestMsg.Headers.Add("Accept", "application/csv") requestMsg.Content = New StringContent(content, Text.UTF8Encoding.Default, "application/x-www-form-urlencoded") response = Await _client.SendAsync(requestMsg) If (response.StatusCode = System.Net.HttpStatusCode.OK) Then Return response.Content.ReadAsStringAsync().Result End If Catch ex As Exception Throw Finally End Try End Function
问题原因与解决方法
核心原因
VBA的MSXML2.XMLHTTP.6.0会自动使用当前Windows用户的凭据进行代理认证,而.NET HttpClient默认不会自动处理代理认证,且你之前的代码把凭据设置给了目标服务器,而非代理服务器。
解决步骤
区分服务器认证与代理认证:
- 代码中的
Authorization头是给目标服务器的Basic认证,这部分无需修改。 - 407错误是代理服务器要求认证,需要单独配置代理凭据。
- 代码中的
修改HttpClientHandler配置:
- 若使用系统默认代理,直接开启
UseDefaultCredentials让HttpClient自动使用当前Windows用户凭据:_clientHandler = New HttpClientHandler() With { .UseDefaultCredentials = True, .PreAuthenticate = True } - 若需要指定代理地址和凭据:
Dim proxy As New WebProxy("http://your-proxy-address:port") proxy.Credentials = New NetworkCredential("proxy-username", "proxy-password") _clientHandler = New HttpClientHandler() With { .Proxy = proxy, .PreAuthenticate = True }
- 若使用系统默认代理,直接开启
统一编码格式:
VBA默认使用ASCII编码,将StringContent的编码改为Encoding.ASCII,避免编码不一致问题:requestMsg.Content = New StringContent(content, Encoding.ASCII, "application/x-www-form-urlencoded")清理冗余代码:
之前添加的CredentialCache是针对目标服务器的,对代理认证无效,可直接移除。
完整修正后的CreateHttpClient方法
Public Sub CreateHttpClient(ByVal target As String) Dim uri As Uri = New Uri(target) If _client Is Nothing Then ' 使用系统默认代理+当前Windows凭据 _clientHandler = New HttpClientHandler() With { .UseDefaultCredentials = True, .PreAuthenticate = True } _client = New HttpClient(_clientHandler) With { .Timeout = New TimeSpan(0, 0, 10), .BaseAddress = uri } End If End Sub
额外注意事项
- 确认代理设置与VBA运行环境一致:VBA使用IE代理配置,.NET HttpClient默认读取系统代理,若有特殊规则需手动指定。
- 若代理需要Basic认证而非Negotiate,可通过CredentialCache明确指定:
Dim proxyCache As New CredentialCache() proxyCache.Add(New Uri("http://your-proxy-address:port"), "Basic", New NetworkCredential("proxy-user", "proxy-pass")) proxy.Credentials = proxyCache
内容的提问来源于stack exchange,提问作者Paul Johnson
相关产品推荐
相关产品推荐

