Использование переменных для сайта при попытке загрузить недоверенный файл сертификата через WinHttp.WinHttpRequest.5.1

Question

Я пытаюсь получить доступ к файлу DoD с недоверенным сертификатом.Я могу использовать код, найденный в этом Исходном сообщении , но мне нужно изменить его, чтобы разрешить переменные.

Веб-адрес / файл: https://www.defensetravel.dod.mil/Docs/perdiem/browse/Allowances/Per_Diem_Rates/Text_Only/OCONUS-Overseas/2019/ovs19-03.xls

Часть в подпрограмме, которая сначала вызывает подпрограмму GetFile У меня есть:

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:\Users\craig\Raw DOD Files\", downloadURL)
End Sub

Затем запускается функция Public, но в строке выдается ошибка: 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:\Users\craig\Raw 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