返回列表下一主題上一主題發帖

VBA如何關閉網頁提示

eukijohn

小學生 Rank: 1

帖子: 2
主題: 1
精華: 0
積分: 4
點名: 0
作業系統: WIN XP
軟體版本: Office 2007
閱讀權限: 10
性別: 男
註冊時間: 2011-1-20
最後登錄: 2018-9-8

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2015-3-7 09:36 | 只看該作者

VBA如何關閉網頁提示

我用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