从Web上下载VBA数据不会影响其他任务?

时间:2016-02-09 14:36:46

标签: excel vba excel-vba internet-explorer-11

VBA Excel是否可以从网站下载数据而不影响其他任务?我想要实现的是能够按下按钮并继续处理其他任务。现在,当我运行下面的代码时,我无法执行其他任务或代码将中断。感谢大家的帮助/输入!

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 pURL As String
    Dim Cell, Rng As Range
    Dim Sheet As Worksheet

    Dim oBrowser As InternetExplorer
    Set oBrowser = New InternetExplorer

    Dim StartTime As Double
    Dim SecondsElapsed As Double

    StartTime = Timer

    '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:Z15"), 2, False)
        bReplace = True
        sURL = "www.preqin.com"
        pURL = Application.WorksheetFunction.VLookup(Cell.Value, Sheet.Range("I2:Z15"), 16, False)

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

        Else: GoTo Exit_Sub
        End If
    Next

Exit_Sub:

    'Close IE
    oBrowser.Quit

    'Determine how many seconds code took to run
    SecondsElapsed = Round(Timer - StartTime, 2)
    MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

End Sub

Private Sub Download_Use_IE(oBrowser As InternetExplorer, _
                            ByRef sURL As String, _
                            ByRef pURL 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

    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:

'Initial data export
    oBrowser.navigate (pURL)
    '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)

Exit Sub

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

2 个答案:

答案 0 :(得分:0)

试试

DoEvents

据我所知,使用后台处理和excel并不容易。

干杯。

答案 1 :(得分:0)

您无法使用运行宏的工作簿。如果要在宏运行时在Excel中工作,可以打开另一个Excel实例或运行宏的工作簿的只读副本。 This question has been asked and answered before on here

很难从您的问题中确定您是在谈论Excel中的“其他任务”还是仅仅在您的计算机上。我的上一段回答了在宏运行时是否可以在Excel中执行任务。