You need to enable JavaScript to run this app.
优惠活动
大模型
产品
解决方案
定价
更多

为何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默认不会自动处理代理认证,且你之前的代码把凭据设置给了目标服务器,而非代理服务器。

解决步骤

  1. 区分服务器认证与代理认证:

    • 代码中的Authorization头是给目标服务器的Basic认证,这部分无需修改。
    • 407错误是代理服务器要求认证,需要单独配置代理凭据。
  2. 修改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
      }
      
  3. 统一编码格式:
    VBA默认使用ASCII编码,将StringContent的编码改为Encoding.ASCII,避免编码不一致问题:

    requestMsg.Content = New StringContent(content, Encoding.ASCII, "application/x-www-form-urlencoded")
    
  4. 清理冗余代码:
    之前添加的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

相关产品推荐
方舟 Agent Plan

超全模态模型 × Harness 升级,最新支持 Deepseek-V4.1-Flash、GLM-5.3 系列、Doubao-Seedream-5.0-pro、Kimi-K3 (部分), 限时 9.9 元起

最近更新时间:2026.07.14 12:52:41