尝试通过WinHttp.WinHttpRequest.5.1下载不受信任的证书文件时使用站点变量

时间:2019-03-19 18:40:49

标签: excel vba

我正在尝试使用不受信任的证书访问DoD文件。我可以使用此Original Post中的代码,但需要对其进行修改以允许变量。

网址/文件为: 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

1 个答案:

答案 0 :(得分: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