如何使用VBA清除弹出的消息框“来自网页的消息”

时间:2019-12-06 17:13:32

标签: excel vba stack-overflow messagebox

我有一个Excel宏,可用于在公共网站上查询股票信息。该宏可帮助从Excel工作表中读取股票代码列表,并将股票代码输入网站以逐个进行查询。

该代码在使用几个月后一直没有问题,但是直到本月为止(猜测公共网站已进行了一些更改)。遇到的问题是:在完成对每个股票代码的查询后,将弹出一个消息框,标题为“来自网页的消息”,标题为“第47行的堆栈溢出”,然后宏停止为下一个股票代码做任何事情。然后,我尝试通过单击“ X”或按键盘的“ Enter”键来简单地关闭消息,消息框消失,宏继续下一个股票代码的工作。

能否请您提供解决弹出消息框的解决方案?像自动点击“确定”还是避免“堆栈溢出”问题?

请在下面查看我使用的代码。谢谢您的帮助!

Private Sub userformAactivate()
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Dim ieapp As Object
    Dim strURL As String
    Dim CompanyNo As String
    Dim CurrentWindow As HTMLWindowProxy
    Dim i As Integer
    Dim j As Integer
    Dim Lastrow As Integer

    Application.Calculation = xlCalculationManual

    Sheets("Main").Column(2).ClearContents
    Sheets("Main").Cells(1, 2).Value = "Website Output"

    'IEuserform.hide
    Lastrow = Sheets("Main").Range("A" & Rows.Count).End(xlUp).Row

    For j = i To Lastrow - 1
        CompanyNo = Sheets("Main").Cells(1 + j, 1).Value

        'Initiate the website and search the company name by company no
        Set ieapp = WebBrowser1
        ieapp.slient = True
        ieapp.navigate "https://www.hkex.com.hk/Market-Data/Securities-Prices/Equities/Equities-Quote?sym=" & CompanyNo & "sc_lang=en"

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

        Do While (ieapp.readystate <> 4)
            DoEvents
            Application.Wait (Now + TimeValue("00:00:01"))
        Loop

        Call whatever

        Set tags = ieapp.document.getelementsbyclassname("col_issued_shares")

        On Error GoTo Errhandler:

        Sheets("Main").Cells(1 + j, 2).Value = Tag(0).innertext

        If Sheets("Main").Cells(1 + j, 2).Value = "" Then
            Sheets("Main").Cells(1 + j, 2).Value = "No info."
        End If

        GoTo Next_i

    Errhandler:
        Application.DisplayAlerts = True
        'Msgbox "Error"
        Sheets("Main").Cells(1 + j, 3).Value = "No info."
        Resume Next_i

    Next_i:
    Next j

    Set ieapp = Nothing

    Application.ScreenUpdating = True
    Application.Calculate
    Application.Calculation = xlCalculationAutomatic

    Unload Me

End Sub



Public Sub whatever()
    Dim time1, time2

    time1 = Now
    time2 = Now + TimeValue("00:00:02")

    Do Until time1 >= time2
        DoEvents
        time1 = Now()
    Loop

End Sub



Private Sub WebBrower1_StatusTextChange(ByVal Text As String)

End Sub

0 个答案:

没有答案