123
返回列表 上一主題 發帖

[發問] CreateObject("InternetExplorer.Application") 執行完有時會無法跳出??

t8899

帖子
760 
主題
250 
精華
0 
積分
1023 
點名
0  
作業系統
windows 11 
軟體版本
OFFICE2021 
閱讀權限
50 
性別
男 
註冊時間
2011-5-30 
最後登錄
2024-11-28 
1# 跳轉到 »
發表於 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會更新)

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2014-1-9 09:08 | 只看該作者
回復 1# t8899

表格中按下滑鼠右鍵

   
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

t8899

帖子
760 
主題
250 
精華
0 
積分
1023 
點名
0  
作業系統
windows 11 
軟體版本
OFFICE2021 
閱讀權限
50 
性別
男 
註冊時間
2011-5-30 
最後登錄
2024-11-28 
3#
發表於 2014-1-9 14:37 | 只看該作者
回復  t8899

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


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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2014-1-9 15:43 | 只看該作者
回復 3# t8899
  1. Option Explicit
  2. Sub TWSE_交易資訊()
  3.     Dim YMD_day As String, N As Name, webURL As String
  4.     YMD_day = InputBox("輸入 民國年度 : 102/10/07", "下載特定日期的資料", Format(Date - 1, "E/MM/DD")) '民國年度 "102/10/07"
  5.     With ActiveSheet  '可指定工作表
  6.         '當日沖銷交易標的及統計
  7.         webURL = "URL;http://www.twse.com.tw/ch/trading/exchange/TWTB4U/TWTB4U.php?input_date=" & YMD_day & "&login_btn=查詢.dat"
  8.         '鉅額交易日成交資訊
  9.         'webURL = "URL; http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?input_date=" & YMD_day & "&login_btn=查詢.dat"
  10.         'webURL = "URL; http://www.twse.com.tw/ch/trading/block/BFIAUU/BFIAUU.php?input_date=" & YMD_day & "&login_btn=%ACd%B8%DF.dat"
  11.         If .QueryTables.Count = 0 Then
  12.             .QueryTables.Add Connection:=webURL, Destination:=.Range("A1")
  13.         Else
  14.             .QueryTables(1).Connection = webURL
  15.         End If
  16.         .Cells.Clear
  17.         With .QueryTables(1)
  18.             .WebSelectionType = xlSpecifiedTables
  19.             .WebFormatting = xlWebFormattingNone
  20.            ' .WebTables = "data_table"  '鉅額交易日成交資訊     :資料匯入的Tables
  21.             .WebTables = "9,11"         '當日沖銷交易標的及統計 :資料匯入的Tables
  22.             .Refresh BackgroundQuery:=False
  23.         End With
  24.     End With
  25. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

t8899

帖子
760 
主題
250 
精華
0 
積分
1023 
點名
0  
作業系統
windows 11 
軟體版本
OFFICE2021 
閱讀權限
50 
性別
男 
註冊時間
2011-5-30 
最後登錄
2024-11-28 
5#
發表於 2014-1-9 18:36 | 只看該作者
回復  t8899
GBKEE 發表於 2014-1-9 15:43


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

TOP

t8899

帖子
760 
主題
250 
精華
0 
積分
1023 
點名
0  
作業系統
windows 11 
軟體版本
OFFICE2021 
閱讀權限
50 
性別
男 
註冊時間
2011-5-30 
最後登錄
2024-11-28 
6#
發表於 2014-1-9 19:55 | 只看該作者
回復  t8899
GBKEE 發表於 2014-1-9 15:43

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

TOP

Brandy

帖子
34 
主題
7 
精華
0 
積分
71 
點名
0  
作業系統
win7 
軟體版本
office2007 
閱讀權限
20 
註冊時間
2012-11-12 
最後登錄
2022-5-2 

2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章
7#
發表於 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

TOP

t8899

帖子
760 
主題
250 
精華
0 
積分
1023 
點名
0  
作業系統
windows 11 
軟體版本
OFFICE2021 
閱讀權限
50 
性別
男 
註冊時間
2011-5-30 
最後登錄
2024-11-28 
8#
發表於 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有何不同?? 第二個可以用改用第一個方法 ??

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
9#
發表於 2014-1-11 09:12 | 只看該作者
回復 8# t8899
  1. Option Explicit
  2. Sub 集中市場大盤資訊()
  3.     Dim x, ie As Object, Sh As Worksheet
  4.     Set ie = CreateObject("InternetExplorer.Application")
  5.    ' ie.Visible = True          '是否顯示 IE
  6.     ie.Navigate "about:Tabs"    '空白的網頁
  7.     Set Sh = ActiveSheet        '設定工作表
  8.     Sh.Cells.Clear
  9.     Application.ScreenUpdating = False
  10.     With CreateObject("InternetExplorer.Application")
  11.     '    .Visible = True        '是否顯示 IE
  12.         .Navigate "http://newmis.twse.com.tw/stock/group.jsp?ex=tse&ind=TIDX#STATISTICS"
  13.         Do While .readyState <> 4
  14.             DoEvents
  15.         Loop
  16.         For Each x In .document.getElementsByTagName("table")
  17.             If x.ID <> "logo" Then
  18.                 With ie
  19.                     .document.body.innerHTML = x.outerHTML
  20.                     Do While .readyState <> 4 Or .busy
  21.                         DoEvents
  22.                     Loop
  23.                     .execwb 17, 2       '  網頁文字 Select All
  24.                     .execwb 12, 2       '  網頁文字 Copy
  25.                     With Sh
  26.                         If .UsedRange.Rows.Count = 1 Then
  27.                             .Range("A1").Select
  28.                         Else
  29.                             .Range("A" & .UsedRange.Rows.Count + 1).Select
  30.                         End If
  31.                         .PasteSpecial Format:="HTML"
  32.                     End With
  33.                 End With
  34.             End If
  35.         Next
  36.         .Quit
  37.     End With
  38.     ie.Quit
  39.     With Sh
  40.         .Columns.WrapText = False
  41.         .Columns.AutoFit
  42.         .[a1].Select
  43.     End With
  44.     Application.ScreenUpdating = True
  45. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

t8899

帖子
760 
主題
250 
精華
0 
積分
1023 
點名
0  
作業系統
windows 11 
軟體版本
OFFICE2021 
閱讀權限
50 
性別
男 
註冊時間
2011-5-30 
最後登錄
2024-11-28 
10# 倒序看帖
打印
tT
發表於 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
收藏 分享

        靜思自在 : 為自己找藉口的人永遠不會進步。
123
返回列表 上一主題