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

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

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

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

1 个答案: