麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] CreateObject("InternetExplorer.Application") 執行完有時會無法跳出?? [打印本頁]

作者: t8899 時間: 2014-1-9 07:27 標題: 有無辦法將此網頁匯入EXCEL ??

本帖最後由 t8899 於 2014-1-9 07:31 編輯

http://www.twse.com.tw/ch/trading/exchange/TWTB4U/TWTB4U.php (網站當天資料大約21:00會更新)

作者: GBKEE 時間: 2014-1-9 09:08

回復 1# t8899

表格中按下滑鼠右鍵

[attach]17223[/attach]

作者: t8899 時間: 2014-1-9 14:37

回復 t8899

表格中按下滑鼠右鍵
GBKEE 發表於 2014-1-9 09:08

日期改為1/8 會變成兩個資料框(都需要匯入)
第一個匯出會變成1/9 (當日)(今日資料晚上才會update)
第二個匯出會變成"此web沒有傳回資料............"

[attach]17226[/attach]

作者: GBKEE 時間: 2014-1-9 15:43

回復 3# t8899

Option Explicit
Sub TWSE_交易資訊()
Dim YMD_day As String, N As Name, webURL As String
YMD_day = InputBox("輸入民國年度 : 102/10/07", "下載特定日期的資料", Format(Date - 1, "E/MM/DD")) '民國年度 "102/10/07"
With ActiveSheet '可指定工作表
'當日沖銷交易標的及統計
webURL = "URL;http://www.twse.com.tw/ch/trading/exchange/TWTB4U/TWTB4U.php?input_date=" & YMD_day & "&login_btn=查詢.dat"
'鉅額交易日成交資訊
'webURL = "URL; http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?input_date=" & YMD_day & "&login_btn=查詢.dat"
'webURL = "URL; http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?input_date=" & YMD_day & "&login_btn=%ACd%B8%DF.dat"
If .QueryTables.Count = 0 Then
.QueryTables.Add Connection:=webURL, Destination:=.Range("A1")
Else
.QueryTables(1).Connection = webURL
End If
.Cells.Clear
With .QueryTables(1)
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
' .WebTables = "data_table" '鉅額交易日成交資訊 :資料匯入的Tables
.WebTables = "9,11" '當日沖銷交易標的及統計 :資料匯入的Tables
.Refresh BackgroundQuery:=False
End With
End With
End Sub

複製代碼

作者: t8899 時間: 2014-1-9 18:36

回復 t8899
GBKEE 發表於 2014-1-9 15:43

您也把鉅額交易日成交資訊也放進來, 謝謝

作者: t8899 時間: 2014-1-9 19:55

回復 t8899
GBKEE 發表於 2014-1-9 15:43

再請教一下，如何不要自動調整欄寬??

作者: Brandy 時間: 2014-1-9 23:33

回復 6# t8899

在with 裡面加上 .AdjustColumnWidth = False，就好了，可以自己用錄製巨集看看錄出什麼程式碼

Option Explicit
Sub TWSE_交易資訊()
Dim YMD_day As String, N As Name, webURL As String
YMD_day = InputBox("輸入民國年度 : 102/10/07", "下載特定日期的資料", Format(Date - 1, "E/MM/DD")) '民國年度 "102/10/07"
With ActiveSheet  '可指定工作表
      '當日沖銷交易標的及統計
      webURL = "URL;http://www.twse.com.tw/ch/trading/exchange/TWTB4U/TWTB4U.php?input_date=" & YMD_day & "&login_btn=查詢.dat"
      '鉅額交易日成交資訊
      'webURL = "URL; http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?input_date=" & YMD_day & "&login_btn=查詢.dat"
      'webURL = "URL; http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?input_date=" & YMD_day & "&login_btn=%ACd%B8%DF.dat"
      If .QueryTables.Count = 0 Then
         .QueryTables.Add Connection:=webURL, Destination:=.Range("A1")
      Else
         .QueryTables(1).Connection = webURL
      End If
      .Cells.Clear
      With .QueryTables(1)
         .AdjustColumnWidth = False
         .WebSelectionType = xlSpecifiedTables
         .WebFormatting = xlWebFormattingNone
         ' .WebTables = "data_table"  '鉅額交易日成交資訊    :資料匯入的Tables
         .WebTables = "9,11"       '當日沖銷交易標的及統計 :資料匯入的Tables
         .Refresh BackgroundQuery:=False
      End With
End With
End Sub

作者: t8899 時間: 2014-1-10 18:33

日期改為1/8 會變成兩個資料框(都需要匯入)
第一個匯出會變成1/9 (當日)(今日資料晚上才會update)
第 ...
t8899 發表於 2014-1-9 14:37

請教一下
1 ==> webURL = "URL;http://www.twse.com.tw/ch/trading/exchange/TWTB4U/TWTB4U.php

2 ==> With CreateObject("InternetExplorer.Application")
.Navigate "http://newmis.twse.com.tw/stock/group.jsp?ex=tse&ind=TIDX#STATISTICS"

1,2有何不同?? 第二個可以用改用第一個方法 ??

作者: GBKEE 時間: 2014-1-11 09:12

回復 8# t8899

Option Explicit
Sub 集中市場大盤資訊()
Dim x, ie As Object, Sh As Worksheet
Set ie = CreateObject("InternetExplorer.Application")
' ie.Visible = True '是否顯示 IE
ie.Navigate "about:Tabs" '空白的網頁
Set Sh = ActiveSheet '設定工作表
Sh.Cells.Clear
Application.ScreenUpdating = False
With CreateObject("InternetExplorer.Application")
' .Visible = True '是否顯示 IE
.Navigate "http://newmis.twse.com.tw/stock/group.jsp?ex=tse&ind=TIDX#STATISTICS"
Do While .readyState <> 4
DoEvents
Loop
For Each x In .document.getElementsByTagName("table")
If x.ID <> "logo" Then
With ie
.document.body.innerHTML = x.outerHTML
Do While .readyState <> 4 Or .busy
DoEvents
Loop
.execwb 17, 2 ' 網頁文字 Select All
.execwb 12, 2 ' 網頁文字 Copy
With Sh
If .UsedRange.Rows.Count = 1 Then
.Range("A1").Select
Else
.Range("A" & .UsedRange.Rows.Count + 1).Select
End If
.PasteSpecial Format:="HTML"
End With
End With
End If
Next
.Quit
End With
ie.Quit
With Sh
.Columns.WrapText = False
.Columns.AutoFit
.[a1].Select
End With
Application.ScreenUpdating = True
End Sub

複製代碼

作者: t8899 時間: 2014-1-13 11:53 標題: CreateObject("InternetExplorer.Application") 執行完有時會無法跳出??

本帖最後由 t8899 於 2014-1-13 12:07 編輯

CreateObject("InternetExplorer.Application") 執行完有時會無法跳出??
有時會在記憶體裡???如果不理它，會越來越多個iexplorer.exe 到最後會出現錯誤.............

Option Explicit
Sub timestock()
Application.ScreenUpdating = False
Dim i As Integer, S As Integer, K As Integer, j As Integer
Dim Element
With CreateObject("InternetExplorer.Application")
      '.Visible = True          '可顯示網頁
   .Navigate "http://newmis.twse.com.tw/stock/group.jsp?ex=tse&ind=TIDX#STATISTICS"
      Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
      Set Element = .document.getelementsbytagname("table")
      On Error Resume Next
            With Sheets("sheet5")
         .Cells.CLEAR
            'For s = 0 To element.Length - 1 '不知此網頁的table內容:請先行測試網頁的完整table內容
         For S = 2 To 3                   '已找出網頁的table內容在 0-3 中
            For i = 0 To Element(S).Rows.Length - 1
                  K = K + 1
               For j = 0 To 5 '資料的欄位共6位
                     .Cells(K, j + 1) = Element(S).Rows(i).Cells(j).innerText
                     '********************************************
                     '不知此網頁的table內容:先行列出 table 位置  *
                     'Sheets(2).Cells(k, J + 1) = s          '*
                     '********************************************
                  Next
            Next
         Next
   '    .Cells.EntireColumn.AutoFit          '自動調整欄寬
   '    .Cells.EntireRow.AutoFit             '自動調整列高
      End With
   .Quit
End With
Set Element = Nothing
  '  MsgBox "0K"
End Sub
[attach]17246[/attach]

作者: t8899 時間: 2014-1-13 15:35

本帖最後由 t8899 於 2014-1-13 15:40 編輯

有時可以跳出??有時又無法跳出??真奇怪.......
仔細觀察，第一次執行為兩個ieplorer.exe 在執行 ??，接下來就一次一個........
我把 .Visible = True '==> enable
殘留是一個空白的網頁

作者: stillfish00 時間: 2014-1-13 16:37

回復 2# t8899
On Error Resume Next 的目的??
非必要別這樣使用

作者: GBKEE 時間: 2014-1-13 17:40

回復 2# t8899
此網頁的程式碼

Option Explicit
Sub timestock()
Application.ScreenUpdating = False
Dim i As Integer, S As Integer, K As Integer, j As Integer
Dim Element
With CreateObject("InternetExplorer.Application")
'.Visible = True '可顯示網頁
.Navigate "http://newmis.twse.com.tw/stock/group.jsp?ex=tse&ind=TIDX#STATISTICS"
Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
Set Element = .document.getelementsbytagname("table")
With Sheets("SHEET5")
.Cells.Clear
'For s = 0 To element.Length - 1 '不知此網頁的table內容:請先行測試網頁的完整table內容
For S = 1 To 3 '已找出網頁的table內容在 0-3 中
For i = 0 To Element(S).Rows.Length - 1
K = K + 1
For j = 0 To Element(S).Rows(i).Cells.Length - 1 '資料的欄位共6位
.Cells(K, j + 1) = Element(S).Rows(i).Cells(j).innerText
Next
Next
Next
' .Cells.EntireColumn.AutoFit '自動調整欄寬
' .Cells.EntireRow.AutoFit '自動調整列高
End With
.Quit
End With
Set Element = Nothing
MsgBox "0K"
End Sub

複製代碼

作者: t8899 時間: 2014-1-14 08:48

本帖最後由 t8899 於 2014-1-14 09:00 編輯

回復 t8899
此網頁的程式碼
GBKEE 發表於 2014-1-13 17:40

1.此網頁有三個表格，我只要
第二個放入A1及
第三個"股票"欄位放入C5
如何修改?
2.由於我30秒會執行一次此程序
借IE 抓開開關關，似乎較慢...用上樓的程序有時還是會卡住無法關閉?(一直出現"ok"訊息視窗")
是否有其他寫法??

作者: t8899 時間: 2014-1-14 09:18

一直出現"ok"訊息視窗是套入我的巨集的一段
For i = 1 To 10
Dim aaa As Variant
aaa = Sheets("Sheet5").Range("C3")
If IsNumeric(aaa) Then Exit For
If Not IsNumeric(aaa) Then Run "timestock"
Next

作者: GBKEE 時間: 2014-1-14 13:50

本帖最後由 GBKEE 於 2014-1-14 13:57 編輯

回復 15# t8899
一直出現"ok"訊息視窗?? 你是中學生應該會關閉這"ok"視窗.有問題試著自己解決,VBA才會進步.
附上檔案看看

作者: t8899 時間: 2014-1-14 14:43

本帖最後由 t8899 於 2014-1-14 14:48 編輯

回復 t8899
一直出現"ok"訊息視窗?? 你是中學生應該會關閉這"ok"視窗.有問題試著自己解決,VBA才會進步. ...
GBKEE 發表於 2014-1-14 13:50

' MsgBox "0K"
主要不是MsgBox 的問題，是ie 跳不出來..........
現在又可以跳出來了!
謝謝! 我自己在慢慢找..........
我也有興趣把它找出來!:)

作者: t8899 時間: 2014-1-14 14:57

回復 t8899
一直出現"ok"訊息視窗?? 你是中學生應該會關閉這"ok"視窗.有問題試著自己解決,VBA才會進步. ...
GBKEE 發表於 2014-1-14 13:50

我改了一下，是否跟這有關??(紅色部份)
Sub timestock()
Application.ScreenUpdating = False
Dim i As Integer, S As Integer, K As Integer, j As Integer
Dim Element
With CreateObject("InternetExplorer.Application")
      '.Visible = True          '可顯示網頁
   .Navigate "http://newmis.twse.com.tw/stock/group.jsp?ex=tse&ind=TIDX#STATISTICS"
      Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
      Set Element = .document.getelementsbytagname("table")
      With Sheets("SHEET5")
      '  .Cells.Clear
        .Range("A1:F17").ClearContents
         'For s = 0 To element.Length - 1 '不知此網頁的table內容:請先行測試網頁的完整table內容
        For S = 2 To 3                  '已找出網頁的table內容在 0-3 中
            For i = 0 To Element(S).Rows.Length - 1
                  K = K + 1
            '  For j = 0 To Element(S).Rows(i).Cells.Length - 1 '資料的欄位共6位
                 j=2
                     .Cells(K, j + 1) = Element(S).Rows(i).Cells(j).innerText
                  Next
        ' Next
         Next
   '    .Cells.EntireColumn.AutoFit          '自動調整欄寬
   '    .Cells.EntireRow.AutoFit             '自動調整列高
      End With
   .Quit
End With
Set Element = Nothing
  '  MsgBox "0K"
End Sub

作者: GBKEE 時間: 2014-1-14 15:31

回復 18# t8899
這方向是對的,有進步

For S = 2 To 3 '找出網頁的table 內容在 0-3 中
'j=2
IF S=2 Then j=? '寫下你的條件
IF S=3 Then j=?

複製代碼

作者: t8899 時間: 2014-1-15 14:38

回復 t8899
這方向是對的,有進步
GBKEE 發表於 2014-1-14 15:31

With CreateObject("InternetExplorer.Application")
.Navigate "http://newmis.twse.com.tw/stock/group.jsp?ex=tse&ind=TIDX#STATISTICS
.Quit

請問30秒抓一次資料, 抓完無須 quit ,可以改成每隔30秒再繼續抓嗎??(中間做一個循還)
不用一直執行 iexplorer.exe 開開關關???

作者: t8899 時間: 2014-1-15 15:16

循還的範圍
.Navigate "http://newmis.twse.com.tw/stock/group.jsp?ex=tse&ind=TIDX#STATISTICS"
      Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
      Set Element = .document.getelementsbytagname("table")
      With Sheets("SHEET1")
         .Cells.Clear
         K = 0
         'For s = 0 To element.Length - 1 '不知此網頁的table內容:請先行測試網頁的完整table內容
         For S = 2 To 2                   '已找出網頁的table內容在 0-3 中
            For i = 0 To Element(S).Rows.Length - 1
                  K = K + 1
            '  For j = 0 To Element(S).Rows(i).Cells.Length - 1 '資料的欄位共6位
               j = 2
                     .Cells(K, j + 1) = Element(S).Rows(i).Cells(j).innerText

            ' Next
            Next
         Next
   '    .Cells.EntireColumn.AutoFit          '自動調整欄寬
   '    .Cells.EntireRow.AutoFit             '自動調整列高
      End With

作者: GBKEE 時間: 2014-1-15 16:31

本帖最後由 GBKEE 於 2014-1-15 19:33 編輯

回復 21# t8899
ThisWorkbook 程式碼

Option Explicit
Dim Ie As Object, Msg As Boolean
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Ie.Quit
End Sub
Private Sub Workbook_Open()
Set Ie = CreateObject("InternetExplorer.Application")
Ie.Navigate "http://newmis.twse.com.tw/stock/group.jsp?ex=tse&ind=TIDX#STATISTICS"
Do While Ie.Busy Or Ie.ReadyState <> 4: DoEvents: Loop
Msg = False
timestock
End Sub
Private Sub timestock()
Dim i As Integer, S As Integer, K As Integer, j As Integer
Dim Element
If Msg = True Then Ie.Quit: End
Application.OnTime Time + #12:00:30 AM#, "ThisWorkbook.timestock"
Application.ScreenUpdating = False
Do While Ie.Busy Or Ie.ReadyState <> 4: DoEvents: Loop
Set Element = Ie.document.getelementsbytagname("table")
With Sheets("sheet5")
.Cells.Clear
For S = 2 To 3 '已找出網頁的table內容在 0-3 中
For i = 0 To Element(S).Rows.Length - 1
K = K + 1
For j = 0 To Element(S).Rows(i).Cells.Length - 1 '資料的欄位共6位
.Cells(K, j + 1) = Element(S).Rows(i).Cells(j).innerText
Next
Next
Next
' .Cells.EntireColumn.AutoFit '自動調整欄寬
' .Cells.EntireRow.AutoFit '自動調整列高
End With
End Sub
Private Sub The_End() '停止的程式
Msg = True
End Sub

複製代碼

作者: t8899 時間: 2014-1-15 19:18

回復 t8899
ThisWorkbook 程式碼
GBKEE 發表於 2014-1-15 16:31

請問如何停止??

作者: t8899 時間: 2014-1-15 20:36

回復 t8899
ThisWorkbook 程式碼
GBKEE 發表於 2014-1-15 16:31

30秒時間想由K1儲存格來控制，要如何改??

Dim i As Integer, S As Integer, K As Integer, j As Integer
Dim Element
Dim RNG
If Sheet3.Range("K1").Value = 1 Then Set RNG = #12:01:00 AM#
If Sheet3.Range("K1").Value = 2 Then Set RNG = #12:02:00 AM#
If Sheet3.Range("K1").Value = 3 Then Set RNG = #12:00:30 AM#
If Sheet3.Range("K1").Value = 4 Then Set RNG = #12:00:10 AM#

Application.OnTime Time + RNG, "timestock"

----------------------------------------------------
#12:01:00 AM# 需要物件 ???

作者: t8899 時間: 2014-1-15 20:53

30秒時間想由K1儲存格來控制，要如何改??

Dim i As Integer, S As Integer, K As Integer, j As Inte ...
t8899 發表於 2014-1-15 20:36

抱歉，打擾.......已解決....................
If Sheet3.Range("K1").Value = 1 Then Application.OnTime Time + #12:01:00 AM#, "timestock"
If Sheet3.Range("K1").Value = 2 Then Application.OnTime Time + #12:02:00 AM#, "timestock"
If Sheet3.Range("K1").Value = 3 Then Application.OnTime Time + #12:00:30 AM#, "timestock"
If Sheet3.Range("K1").Value = 4 Then Application.OnTime Time + #12:00:10 AM#, "timestock"

作者: t8899 時間: 2014-1-16 05:59

回復 t8899
此網頁的程式碼
GBKEE 發表於 2014-1-13 17:40

是否少了 Set Element = Nothing 這一行??
應插在34或36行前面??

作者: GBKEE 時間: 2014-1-16 07:25

回復 26# t8899

Private Sub timestock()
Dim i As Integer, S As Integer, K As Integer, j As Integer
Dim Element
'timestock這程序內的Dim宣告是為timestock這程序的私用變數
'timestock這程序執行完畢所有的私用變數會自動釋放
'無須 Set Element = Nothing

複製代碼

作者: t8899 時間: 2014-2-10 14:57

本帖最後由 t8899 於 2014-2-10 14:59 編輯

回復 t8899
GBKEE 發表於 2014-1-16 07:25

請問今天連了兩了小時出現錯誤在這一行
Do While Ie.Busy Or Ie.ReadyState <> 4: DoEvents: Loop

[attach]17464[/attach]
如何解決?
1直接跳出
2.不理會錯誤
此兩種狀況，各如何處理?

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)