VBA如何關閉網頁提示

eukijohn

我用VBA拼湊改寫了以下程式碼，可以下載，但是當網頁出現查無資料時，跳出網頁提示，請問如何關閉網頁提示

Option Explicit
Public eachcode(20000) As String
Public DataDate() As String
Sub Query()
    Dim objIE As InternetExplorer
    Dim objDoc As HTMLDocument
    Dim objTable As HTMLTable
    Dim objRow As HTMLTableRow
    Dim strURL As String
    Dim i As Integer, j As Integer, m As Integer, n As Integer, ri As Integer, rj As Integer
    Dim NumDate As Integer
    Dim Fn As String
    Dim A1() As String
    Dim InputStr, S3, vfname As String
    Dim vdata As Variant
    Dim arows, acols As Long
        
    Fn = FreeFile
   
    Open ActiveWorkbook.Path & "\" & "stockcode.txt" For Input As #Fn    '開啟 stockcode.txt 檔
    Application.ScreenUpdating = False '畫面暫停更新
    m = 0
    While Not EOF(Fn)
        Line Input #Fn, InputStr '從檔案讀出一列,
        If Len(InputStr) > 0 Then '略過無字串的空行
            eachcode(m) = Trim(InputStr)
            '把讀入的文字列置於 eachcode 陣列裡
        End If
        m = m + 1
    Wend
    Application.ScreenUpdating = True '畫面恢復更新
    Close #Fn
    strURL = "http://www.tdcc.com.tw/smWeb/QryStock.jsp"
        
    Set objIE = New InternetExplorer
   
    With objIE
        .Navigate strURL
'        .Visible = True
        Do While .Busy Or .ReadyState <> READYSTATE_COMPLETE
            DoEvents
        Loop
        Set objDoc = .Document
    End With
    NumDate = objDoc.getElementsByName("SCA_DATE").Item.Length
    ReDim DataDate(NumDate - 1)
    For i = 0 To NumDate - 1
        DataDate(i) = objDoc.getElementsByName("SCA_DATE").Item.Item(i).innerText
    Next
    S3 = ""
    ChDir ActiveWorkbook.Path & "\"
    On Error Resume Next    '
    For n = 0 To m - 1
        Application.Windows(ThisWorkbook.Name).Activate
        'Sheet1.Activate
        Cells.Select
        Selection.Clear
        Cells(1, 1) = eachcode(n)
        For i = 0 To NumDate - 1
            
            With objDoc
                .getElementsByName("StockNo").Item.Value = eachcode(n)
                .getElementsByName("SCA_DATE").Item.selectedIndex = i
                .getElementsByName("sub").Item.Click
            End With
            Application.Wait Now + TimeSerial(0, 0, 3)
            
            
            Application.ScreenUpdating = False
            
            Set objTable = objDoc.getElementsByTagName("TABLE").Item(7)
            For ri = 0 To objTable.Rows.Length - 1
                Set objRow = objTable.Rows(ri)
                For rj = 0 To objRow.Cells.Length - 1
                    Cells(3 + 20 * i + ri, 1 + rj) = objRow.Cells(rj).innerText
                Next
            Next
            'Range(Cells(1 + 20 * i, 1), Cells(1 + 20 * i, 5)).EntireColumn.AutoFit
            Cells(1 + 20 * i, 2) = objDoc.getElementsByTagName("TABLE").Item(5).innerText
            Cells(1 + 20 * i, 5) = objDoc.getElementsByTagName("TABLE").Item(6).innerText
            
            Application.ScreenUpdating = True
        Next
        
        ActiveSheet.UsedRange.Select
        arows = Selection.Rows.Count
        acols = Selection.Columns.Count
        vfname = eachcode(n) + ".csv"
        Open vfname For Output As #1     '定義Output File位置
        For i = 1 To arows
            For j = 1 To acols - 1
                vdata = Selection.Cells(i, j).Text
                vdata = Replace(vdata, ",", "")
                Write #1, vdata;
            Next j
            Write #1, Selection.Cells(i, acols).Text
        Next i
        Close #1
    Next
    objIE.Quit
    Set objRow = Nothing
    Set objTable = Nothing
    Set objDoc = Nothing
    Set objIE = Nothing   
End Sub

GBKEE

回復 1# eukijohn


   可參考一下