Question

所以我有一个从网站导出数据的循环。但是，对于每种情况，它都会启动一个新会话并关闭。是否有一种方法可以在一个 IE11会话中导航和下载所有案例，然后关闭？以下是我现在的代码：

Public Sub Get_File()

    Dim sFiletype As String     'Fund type reference
    Dim sFilename As String     'File name (fund type + date of download), if "" then default
    Dim sFolder As String       'Folder name (fund type), if "" then default
    Dim bReplace As Boolean     'To replace the existing file or not
    Dim sURL As String          'The URL to the location to extract information
    Dim Cell, Rng As Range
    Dim Sheet As Worksheet

    'Initialize variables
    Set Rng = Range("I2:I15")
    Set Sheet = ActiveWorkbook.Sheets("Macro_Button")

    For Each Cell In Rng
        If Cell <> "" Then
        sFiletype = Cell.Value
        sFilename = sFiletype & "_" & Format(Date, "mmddyyyy")
        sFolder = Application.WorksheetFunction.VLookup(Cell.Value, Sheet.Range("I2:J15"), 2, False)
        bReplace = True
        sURL = "www.preqin.com"

        'Download using the desired approach, XMLHTTP / IE
            If Application.WorksheetFunction.VLookup(Cell.Value, Sheet.Range("I2:W15"), 15, False) = 1 Then
            Call Download_Use_IE(sURL, sFilename, sFolder, bReplace)
            Else
            Call Download_NoLogin_Use_IE(sURL, sFilename, sFolder, bReplace)
            End If

        Else
        Exit Sub
        End If
    Next

End Sub

Private Sub Download_Use_IE(ByRef sURL As String, _
                            Optional ByRef sFilename As String = "", _
                            Optional ByRef sFolder As String = "", _
                            Optional ByRef bReplace As Boolean = True)

    Dim oBrowser As InternetExplorer
    Dim hDoc As HTMLDocument
    Dim objInputs As Object
    Dim ele As Object

    On Error GoTo ErrorHandler

    'Create IE object
    Set oBrowser = New InternetExplorer
    oBrowser.Visible = True

    'Navigate to URL
    Call oBrowser.navigate(sURL)
    While oBrowser.Busy Or oBrowser.readyState <> 4: DoEvents: Wend

    'Skips log in step if already signed into website
    On Error GoTo LoggedIn

    'Enter username
    oBrowser.document.getElementById("ctl00_ctl00_cphSiteHeader_ucLoginForm_user_email").Value = "XXX"
    oBrowser.document.getElementById("ctl00_ctl00_cphSiteHeader_ucLoginForm_user_password").Value = "XXX"

    'Submit the sign in
    oBrowser.document.getElementById("ctl00_ctl00_cphSiteHeader_ucLoginForm_btnLogin").Click
    'Wait for website to load
    While oBrowser.Busy Or oBrowser.readyState <> 4: DoEvents: Wend

LoggedIn:

'All PE
    oBrowser.navigate Range("H3").Value
    'Wait for website to load
    While oBrowser.Busy Or oBrowser.readyState <> 4: DoEvents: Wend
    'Set the htmldocument
    Set hDoc = oBrowser.document

    'Loop and click the download file button
    Set objInputs = oBrowser.document.getElementsbyTagName("input")
    For Each ele In objInputs
        If ele.Title Like "Download Data to Excel" Then
            ele.Click
        End If
    Next

    'Wait for dialogue box to load
    While oBrowser.Busy Or oBrowser.readyState > 3: DoEvents: Wend
    Application.Wait (Now + TimeValue("0:00:02"))

    'IE 9+ requires to confirm save
    Call Download(oBrowser, sFilename, sFolder, bReplace)

    'Close IE
    oBrowser.Quit

Exit Sub

ErrorHandler:
    'Resume
    Debug.Print "Sub Download_Use_IE() " & Err & ": " & Error(Err)
End Sub

Answer 1

修改download_IE过程以使用传递给它的浏览器：

Private Sub Download_Use_IE(oBrowser As InternetExplorer, _
                           ByRef sURL As String, _
                        Optional ByRef sFilename As String = "", _
                        Optional ByRef sFolder As String = "", _
                        Optional ByRef bReplace As Boolean = True)

    Dim hDoc As HTMLDocument
    Dim objInputs As Object
    Dim ele As Object

    On Error GoTo ErrorHandler

    'Create IE object

    oBrowser.Visible = True

    'Navigate to URL

    Call oBrowser.navigate(sURL)

    ......rest of code

    Call Download(oBrowser, sFilename, sFolder, bReplace)

    'Do not Close IE

 Exit Sub

 ErrorHandler:
     'Resume
     Debug.Print "Sub Download_Use_IE() " & Err & ": " & Error(Err)
 End Sub

然后修改您的过程以传递此对象：

Public Sub Get_File()

    'declare all variables plus:

     Dim oBrowser As InternetExplorer

     Set oBrowser = New InternetExplorer

     .....put additional code here.....

     If Application.WorksheetFunction.VLookup(Cell.Value, Sheet.Range("I2:W15"), 15, False) = 1 Then
         Call Download_Use_IE(oBrowser, sURL, sFilename, sFolder, bReplace)
        Else
        Call Download_NoLogin_Use_IE(oBrowser, sURL, sFilename, sFolder, bReplace)
        End If
      Else
         Exit Sub
      End If
    Next

     'Close IE
     oBrowser.Quit

 End Sub

您需要为其他程序执行相同的操作。

与Active / Single IE11 Session VBA交互

1 个答案: