与主动/单个IE11会话VBA进行交互
所以我有一个从网站导出数据的循环。 但是，对于每种情况，都将启动一个新的会话并closures。 有没有一种方法可以在一个 IE11会话中导航和下载所有的案例，然后closures？ 下面是我现在的代码：
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 修改您的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
你需要为其他程序做同样的事情。