尝试通过winhttp.winhttprequest.5.1下载不信任的证书文件时，请使用网站变量

Question

我正在尝试访问带有不信任的证书的DOD文件。我可以使用此原始帖子中找到的代码，但需要对其进行修改以允许变量。

网址/文件是：https://www.defensetravel.dod.mil/docs/perdiem/browse/allowances/per_diem_rates/text_only/oconles-oconus-overseas/2019/ovs19/ovs19/ovs19-19-03.xls

第一次称为getfile sub的零件我有：

downloadURL = "https://www.defensetravel.dod.mil/Docs/perdiem/browse/Allowances/Per_Diem_Rates/Text_Only/OCONUS-Overseas/2019/ovs" & strTwoDigitYear & "-" & strTwoDigitMonth & ".xls"

URL更改中的两个变量取决于月和年度（如网址/文件的命名）。那我的GetFile子是：

Public Sub GetFile(ByVal downloadURL As String)
Debug.Print DownloadFile("C:UserscraigRaw DOD Files", downloadURL)
End Sub

然后，公共函数运行，但会在行上出现错误：http.send。错误是"运行时错误" -2147012851（80072F0D）'：证书授权无效或不正确。该变量仍然具有范围，链接是正确的，因此我很想知道WinHTTP是否有一些可以阻止使用变量的东西，因为我没有使用WinHTTP。

Public Function DownloadFile(ByVal downloadFolder As String, ByVal downloadURL As String) As String
    Dim http As Object, tempArr As Variant
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    http.Open "GET", downloadURL, False
    http.Option(4) = intSslErrorIgnoreFlags
    http.Send
    On Error GoTo errhand
    With CreateObject("ADODB.Stream")
        .Open
        .Type = 1
        .write http.responseBody
        tempArr = Split(downloadURL, "/")
        tempArr = tempArr(UBound(tempArr))
        .SaveToFile downloadFolder & tempArr, 2  '< "/" on enter of downloadFolder. 2 for overwrite which is Ok if no file modifications.
        .Close
    End With
    DownloadFile = downloadFolder & tempArr
    Exit Function
errhand:
    If Err.Number <> 0 Then
        Debug.Print Err.Number, Err.Description
        MsgBox "Download failed"
    End If
    DownloadFile = vbNullString
End Function

Answer 1

尝试以下（确保存在const标志）

Option Explicit
Const IGNORE_SSL_ERROR_FLAG As Long = 13056
Public Sub test()
    GetFile "https://www.defensetravel.dod.mil/Docs/perdiem/browse/Allowances/Per_Diem_Rates/Text_Only/OCONUS-Overseas/2019/ovs19-03.xls"
End Sub
Public Sub GetFile(ByVal downloadURL As String)
    Debug.Print DownloadFile("C:UserscraigRaw DOD Files", downloadURL)
End Sub
Public Function DownloadFile(ByVal downloadFolder As String, ByVal downloadURL As String) As String
    Dim http As Object, tempArr As Variant
    Set http = CreateObject("WinHttp.WinHttpRequest.5.1")
    http.Open "GET", downloadURL, False
    http.Option(4) = IGNORE_SSL_ERROR_FLAG
    http.send
    On Error GoTo errhand
    With CreateObject("ADODB.Stream")
        .Open
        .Type = 1
        .write http.responseBody
        tempArr = Split(downloadURL, "/")
        tempArr = tempArr(UBound(tempArr))
        .SaveToFile downloadFolder & tempArr, 2  '< "/" on enter of downloadFolder. 2 for overwrite which is Ok if no file modifications.
        .Close
    End With
    DownloadFile = downloadFolder & tempArr
    Exit Function
errhand:
    If Err.Number <> 0 Then
        Debug.Print Err.Number, Err.Description
        MsgBox "Download failed"
    End If
    DownloadFile = vbNullString
End Function