将IE的第二个选项卡分配给对象变量

Question

完整目的：以编程方式从DoD网站下载XLS文件，而无需信任该证书。

详细信息：我希望通过我的代码与第二个选项卡进行交互。目前，代码继续使用第一个选项卡。在我最后一小时在网上找到的内容中，通常是通过检查第二页的URL来完成的。问题是第二页与第一页具有相同的URL。第二个出现是因为我试图规避的证书问题。 （IT无法修复证书问题。）我希望能够使用第二个选项卡，所以如果我们必须杀死第一个选项卡，那也没关系。一旦我的链接全部被点击，就会出现一个IE框询问我想要对文件做什么，打开，保存或另存为。我是否也可以控制这个盒子，告诉它打开（因为如果没有，我会浪费我的时间）？这就是我所拥有的......

'http://www.exceltrainingvideos.com/how-to-follow-multiple-hyperlinks-and-extract-webpage-data/
Sub testweb()

mystart:

Set objIE = CreateObject("InternetExplorer.Application")
objIE.Top = 0
objIE.Left = 0
objIE.Width = 1600
objIE.Height = 900
objIE.Visible = True

On Error Resume Next
objIE.Navigate ("https://www.defensetravel.dod.mil/site/pdcFiles.cfm?dir=/Allowances/Per_Diem_Rates/Text_Only/OCONUS-Overseas/ovs19-01.xls")

Application.Wait (Now + TimeValue("0:00:04"))

Do
DoEvents
If Err.Number <> 0 Then
    objIE.Quit
    Set objIE = Nothing
    GoTo mystart:
End If
Loop Until objIE.ReadyState = 4

Set alllinks = objIE.document.getElementsByTagName("A")         'click year
For Each Hyperlink In alllinks
If InStr(Hyperlink.innertext, " 2019") > 0 Then
    Hyperlink.Click
Exit For
End If
Next

Application.Wait (Now + TimeValue("0:00:02"))

Set alllinks = objIE.document.getElementsByTagName("A")         'click file name
For Each Hyperlink In alllinks
    If InStr(Hyperlink.innertext, " ovs19-01.xls") > 0 Then         'item 45
        Hyperlink.Click
        Exit For
    End If
Next
Stop

Application.Wait (Now + TimeValue("0:00:04"))

下面是我需要我的代码开始使用第二页的地方**

Set alllinks = objIE.document.getElementsByTagName("A")         'click More Info link
For Each Hyperlink In alllinks
    If InStr(Hyperlink.innertext, "More information") > 0 Then
        Hyperlink.Click
        Exit For
    End If
Next
Stop

Application.Wait (Now + TimeValue("0:00:02"))

Set alllinks = objIE.document.getElementsByTagName("A")        'click Go on to the webpage...
For Each Hyperlink In aAlllinks
    If InStr(Hyperlink.innertext, "Go on to the webpage (not recommended)") > 0 Then
        Hyperlink.Click
        Exit For
    End If
Next
Stop

objIE.Quit

End Sub

Answer 1

您可以直接使用下载URL并指定忽略证书警告标志

Option Explicit

Const IGNORE_SSL_ERROR_FLAG As Long = 13056
Public Sub GetFile()

    Debug.Print DownloadFile("C:\Users\User\Desktop\", "https://www.defensetravel.dod.mil/Docs/perdiem/browse/Allowances/Per_Diem_Rates/Text_Only/OCONUS-Overseas/2019/ovs19-03.xls")

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