VBA调用WinHttpRequest的SetClientCertificate实现TLS1.2请求证书传递求助

WinHttpRequest.SetClientCertificate方法的入参不需要传入证书原始字符串，仅需要传入系统证书存储区的目标证书定位字符串，格式为 [存储位置]\[存储区名称]\[证书匹配标识]。

参数规则说明 #

• 存储位置可选值：
  • CURRENT_USER：读取当前登录用户的证书存储区，无需管理员权限，为最常用选项
  • LOCAL_MACHINE：读取本地计算机全局证书存储区，需要Excel以管理员身份运行才能正常访问
• 存储区名称：个人类客户端证书默认存放在My存储区，对应系统证书管理工具中的「个人」分类
• 证书匹配标识：可填写证书的主题通用名(CN)，也可填写证书的十六进制指纹（需提前删除所有空格），优先用指纹可避免同名证书匹配错误

代码修正要点 #

原有代码存在两个可导致功能失效的问题：

1. SetClientCertificate调用顺序错误，必须放在Open方法执行之后、Send方法执行之前
2. 入参格式错误，需按上述规则替换为你的证书定位字符串

修正后示例代码 #

Public Sub restApiCallV2()
    Dim httpSender As WinHttp.WinHttpRequest
    Dim strUrl As String
    Dim strResponse As String
    Dim Failure As Boolean

    strUrl = "https://jsonplaceholder.typicode.com/todos/2"

    On Error GoTo eh
    Set httpSender = New WinHttp.WinHttpRequest

    '强制使用TLS 1.2
    httpSender.Option(WinHttpRequestOption_SecureProtocols) = SecureProtocol_TLS1_2
    httpSender.Option(WinHttpRequestOption_EnableRedirects) = True

    '先执行Open方法，再设置客户端证书
    httpSender.Open "GET", strUrl, False
    ' 按实际情况替换为你的证书定位字符串，示例为当前用户存储、个人存储区、证书主题为"API客户端证书"
    httpSender.SetClientCertificate "CURRENT_USER\My\API客户端证书"
    
    httpSender.setRequestHeader "User-Agent", "My App V1.0"
    httpSender.setRequestHeader "Content-type", "application/json"

    Debug.Print "Calling..."

    httpSender.Send ""
    Failure = (httpSender.Status <> 200)
    If Not Failure Then
        strResponse = httpSender.responseText
        Debug.Print strResponse
        Debug.Print "Completed!"
    Else
        Call Err.Raise(5000, "start_here.restApiCallV2", "Failure: received status : " & httpSender.Status)
    End If

    Exit Sub
eh:
    Debug.Print "Error!"
    Debug.Print "Number: " & Err.Number & ", Source: " & Err.Source & ", Description: " & Err.Description
End Sub

常见排查点 #

• 若提示找不到证书，可运行certmgr.msc打开当前用户证书管理器，确认证书确实存放在「个人」-「证书」分类下，且填写的主题/指纹与证书信息完全匹配
• 若使用本地计算机存储区，需右键点击Excel图标，选择「以管理员身份运行」后再执行代码

内容的提问来源于stack exchange，提问作者baruchl