12
返回列表 上一主題 發帖

[發問] vba 操作ie匯入資料

randomwalk

帖子
3 
主題
1 
精華
0 
積分
4 
點名
0  
作業系統
winxp 
軟體版本
office2007 
閱讀權限
10 
性別
男 
註冊時間
2013-5-17 
最後登錄
2014-12-12 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2013-5-17 06:02 | 只看該作者

[發問] vba 操作ie匯入資料

各位好
請問能以vba 開啟以下網址並完成
http://mops.twse.com.tw/mops/web/t164sb04
1.最新資料改成歷史資料
2.公司代號輸入2330
3.年度102
4.選第一季
並在查詢出資料後匯入excel,

因為今年度IFRS上路後,公開資訊站大改版,原本可以用http語法查詢出個別公司報表,
望網兄不吝指教,感謝
收藏 分享

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2013-5-19 15:17 | 只看該作者
本帖最後由 GBKEE 於 2013-5-19 15:36 編輯

回復 1# randomwalk
這網頁: 無論是[最新資料] 或 [歷史資料] 的資料都一樣???
  1. Sub Ex()
  2.     Dim i As Integer, s As Integer, k As Integer, A, ii, j
  3.     Dim co_id As String, isnew As String, season As String
  4.     co_id = InputBox("請輸入 公司代號")
  5.     If Not IsNumeric(Val(co_id)) Or Len(co_id) <> 4 Then Exit Sub              '不是四位數的數字
  6.     isnew = InputBox("1:最新資料，２:歷史資料" & vbLf & "請選 1 , 2")
  7.     If isnew <> "1" And isnew <> "2" Then Exit Sub                              '沒選1 或 2
  8.     If isnew = "2" Then season = InputBox("輸入年度 , 季別" & vbLf & "例 101,01")
  9.                                     '第一季 01,第二季 02第三季 03,第四季 04.
  10.     With CreateObject("InternetExplorer.Application")
  11.         .Visible = True
  12.         .Navigate "http://mops.twse.com.tw/mops/web/t164sb04"
  13.         Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
  14.         With .document
  15.             For Each A In .getelementsbytagname("INPUT")
  16.                 If A.Name = "co_id" Then A.Value = co_id
  17.             Next
  18.             For Each A In .getelementsbytagname("SELECT")
  19.                 If A.Name = "isnew" Then
  20.                     A.Value = True
  21.                     If isnew = "2" Then
  22.                         A.Focus
  23.                         Application.Wait Now + #12:00:02 AM#
  24.                         Application.SendKeys "{DOWN}"
  25.                         Application.Wait Now + #12:00:02 AM#
  26.                         Application.SendKeys "{ENTER}"
  27.                     End If
  28.                 End If
  29.                 If A.Name = "year" And isnew = "2" Then A.Value = Split(season, ",")(0)
  30.                 If A.Name = "season" And isnew = "2" Then A.Value = Split(season, ",")(1)
  31.             Next
  32.             For Each A In .getelementsbytagname("INPUT")
  33.                 If Trim(A.Value) = "搜尋" And A.Name <> "rulesubmit" Then A.Click        '按下[搜索]鍵
  34.             Next
  35.         End With
  36.         Application.Wait Now + #12:00:10 AM#                     '等待網頁下載資料
  37.         Set A = .document.getelementsbytagname("table")
  38.         On Error Resume Next       '***有些table沒Rows資料會產生錯誤 不理會它,程式繼續走
  39.         With ActiveSheet
  40.             .Cells.Clear
  41.            '************************
  42.            ' For ii = 0 To A.Length - 1        '不知道table範圍在何處: 從0開始
  43.            '******************************
  44.             For ii = 11 To A.Length - 1        ''從11開始 用 Debug.Print ii  找出所要資料的table範圍
  45.                 For i = 0 To A(ii).Rows.Length - 1      '寫入資料
  46.                 'Debug.Print ii  可找出所要資料的 table 範圍
  47.                 k = k + 1
  48.                 For j = 0 To 5
  49.                     Cells(k, j + 1) = A(ii).Rows(i).Cells(j).innerText
  50.                 Next
  51.             Next
  52.             Next
  53.             .Range("C5").Cut Range("D5")
  54.             With .Range("B5:C5,D5:E5")
  55.                 .HorizontalAlignment = xlCenter
  56.                 .VerticalAlignment = xlCenter
  57.                 .Merge
  58.             End With
  59.         End With
  60.         .Quit        '關閉網頁
  61.     End With
  62. End Sub
複製代碼
  1. Option Explicit
  2. Dim 網頁 As Object
  3. Sub Ex簡易手動()
  4.     '程式第一次執行: 打開網頁,在網頁中手動,選擇資料後 , 按[搜尋]鍵!!
  5.     '程式第二次執行: 讀取網頁資料到 Excel中.
  6.     '往後在網頁資料有修改,只需執行一次即可讀取網頁資料到 Excel中.
  7.     Dim i As Integer, ii As Integer, k As Integer, j As Integer, A As Object
  8.     On Error GoTo RE網頁
  9. 1:
  10.     If 網頁 Is Nothing Then
  11.         Set 網頁 = CreateObject("InternetExplorer.Application")
  12.          With 網頁
  13.             .Visible = True
  14.             .Navigate "http://mops.twse.com.tw/mops/web/t164sb04"
  15.             .Height = 500
  16.             .Width = 1300
  17.         End With
  18.         Application.WindowState = xlMinimized  'Excel 最小化
  19.         Exit Sub
  20.     End If
  21.     If 網頁.Visible = False Then
  22.         網頁.Value = True
  23.         Application.WindowState = xlMinimized
  24.         Exit Sub
  25.     End If
  26.     '**********讀取網頁 資料 *******************
  27.     Set A = 網頁.document.getelementsbytagname("table")
  28.     With ActiveSheet                               '作用中的工作表
  29.          .Cells.Clear
  30.          On Error Resume Next
  31.         For ii = 11 To A.Length - 1                     
  32.             For i = 0 To A(ii).Rows.Length - 1      '寫入資料
  33.                 k = k + 1
  34.                 For j = 0 To 5
  35.                     Cells(k, j + 1) = A(ii).Rows(i).Cells(j).innerText
  36.                 Next
  37.             Next
  38.         Next
  39.         .Range("C5").Cut .Range("D5")
  40.         With .Range("B5:C5,D5:E5")
  41.             .HorizontalAlignment = xlCenter
  42.             .VerticalAlignment = xlCenter
  43.             .Merge
  44.         End With
  45.     End With
  46. Exit Sub
  47. RE網頁:   '
  48.      Set 網頁 = Nothing
  49.     Resume 1
  50. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

yuch8663

帖子
51 
主題
12 
精華
0 
積分
77 
點名
0  
作業系統
windows xp sp3 
軟體版本
excel 2003 2007 
閱讀權限
20 
註冊時間
2010-5-4 
最後登錄
2023-10-31 
3#
發表於 2013-5-19 16:46 | 只看該作者
回復 2# GBKEE


    請問GBKEE大大，如果要一次輸入更多公司代號讓程式自動下載後另存新檔，應該如何修改，謝謝。

TOP

randomwalk

帖子
3 
主題
1 
精華
0 
積分
4 
點名
0  
作業系統
winxp 
軟體版本
office2007 
閱讀權限
10 
性別
男 
註冊時間
2013-5-17 
最後登錄
2014-12-12 
4#
發表於 2013-5-19 16:47 | 只看該作者
回復 2# GBKEE


謝謝GBKEE指導
這個網頁是綜合損益表,2013年後上市櫃公司由公布損益表改為公布綜合損益表,
目前只有第一季公布,所以最新資料跟歷史資料都是第一季,
等第二季公布後,就不同了

再請教:
小弟習慣用以下這種語法在抓網頁,似乎前提是能夠找出資料的http,請問上面的綜合損益表能夠找出嗎?
With ActiveSheet.QueryTables.Add(Connection:="URL;http://dj.mybank.com.tw/z/zc/zca/zca_" & mywb1.Sheets("Price").Cells(i, "A") & ".asp.htm", Destination:=Range("$A$1"))
End With

另外GBKEE兄上面提供的程式中,用到的
.getelementsbytagname("INPUT")    =>"co_id" 為公司代號
.getelementsbytagname("SELECT")   =>有"isnew" "year" "season"
請問要怎樣從網頁知道是("INPUT")  或是("SELECT")  ,以及如何找出他們的name 各是"isnew" "year" "season",

感謝GBKEE兄願意指導,謝謝

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
5#
發表於 2013-5-19 17:46 | 只看該作者
回復 3# yuch8663
如果要一次輸入更多公司代號讓程式自動下載後另存新檔
你要如何存檔? 給個範例才知要如何修改.
回復 4# randomwalk
改版最大就是不讓用 QueryTables.Add 大量讀取資料,作流量控管的.

如圖慢慢研究

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

TOP

lalalada

帖子
102 
主題
17 
精華
0 
積分
129 
點名
0  
作業系統
windows 
軟體版本
2010 
閱讀權限
20 
性別
男 
註冊時間
2012-5-16 
最後登錄
2020-9-2 
6#
發表於 2013-5-20 21:38 | 只看該作者
以2498在102年第一季的資料來說
varbody="encodeURIComponent=1&step=1&firstin=1&off=1&keyword4=&code1=&TYPEK2=&checkbtn=&queryName=co_id&TYPEK=all&isnew=false&co_id=2498&year=102&season=01"
由此可以觀察到對應的參數位置
使用post方法
最後另存成csv
改一下就可以全部下載囉
我的vba正在跑不能測 所以以上皆猜測 不過這些網站的原理幾乎都一樣...

TOP

cji3cj6xu6

帖子
112 
主題
19 
精華
0 
積分
136 
點名
0  
作業系統
window 
軟體版本
excel 
閱讀權限
20 
性別
男 
註冊時間
2013-3-12 
最後登錄
2022-11-29 

論壇贊助勳章
7#
發表於 2013-5-22 18:46 | 只看該作者
謝謝版大的問題，也謝謝g大的回覆，剛好我也在想要如何發問。

G大想請教一下，
我將你的表頭改為

For DQ = 1 To 5
    DQQ = 6
    Sheets(DQQ).Select
     co_id = Range("A" & DQ).Value
     Sheets(DQ).Select
    'If Not IsNumeric(Val(co_id)) Or Len(co_id) <> 4 Then Exit Sub              '不是四位數的數字
    isnew = 1

也就是說，我將個股的代號放在page6的a1∼a5，但是想請教一下，
為何只有第一項的資料會進入page1，其他的page2 ~ page5 均為空白，
不曉得您的程式哪裡還需要動到。
Thanks.

TOP

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
8#
發表於 2013-5-22 20:12 | 只看該作者
回復 7# cji3cj6xu6
請上傳檔案說明一下.
沒看到完整的程式j我也不暸解, 為何只有第一項的資料會進入page1，其他的page2 ~ page5 均為空白，
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

cji3cj6xu6

帖子
112 
主題
19 
精華
0 
積分
136 
點名
0  
作業系統
window 
軟體版本
excel 
閱讀權限
20 
性別
男 
註冊時間
2013-3-12 
最後登錄
2022-11-29 

論壇贊助勳章
9#
發表於 2013-5-22 22:17 | 只看該作者
Dear G大謝謝您的費心，如上所提，我只修改表頭與endsub前的Next DQ，僅此而已，
實際上也看到IE的股票代號有動作，但page2 ~page5 並沒有將資料帶進來??

Sub Ex()
    Dim i As Integer, s As Integer, k As Integer, A, ii, j
    Dim co_id As String, isnew As String, season As String
    Dim DQ as Integer, DQQ As Integer
     For DQ = 1 To 5
    DQQ = 6
    Sheets(DQQ).Select
     co_id = Range("A" & DQ).Value
     Sheets(DQ).Select
    isnew = 1
    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .Navigate "http://mops.twse.com.tw/mops/web/t164sb04"
        Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
        With .document
            For Each A In .getelementsbytagname("INPUT")
                If A.Name = "co_id" Then A.Value = co_id
            Next
            For Each A In .getelementsbytagname("SELECT")
                If A.Name = "isnew" Then
                    A.Value = True
                    If isnew = "2" Then
                        A.Focus
                        Application.Wait Now + #12:00:02 AM#
                        Application.SendKeys "{DOWN}"
                        Application.Wait Now + #12:00:02 AM#
                        Application.SendKeys "{ENTER}"
                    End If
                End If
                If A.Name = "year" And isnew = "2" Then A.Value = Split(season, ",")(0)
                If A.Name = "season" And isnew = "2" Then A.Value = Split(season, ",")(1)
            Next
            For Each A In .getelementsbytagname("INPUT")
                If Trim(A.Value) = "搜尋" And A.Name <> "rulesubmit" Then A.Click        '按下[搜索]鍵
            Next
        End With
        Application.Wait Now + #12:00:10 AM#                     '等待網頁下載資料
        Set A = .document.getelementsbytagname("table")
        On Error Resume Next       '***有些table沒Rows資料會產生錯誤 不理會它,程式繼續走
        With ActiveSheet
            .Cells.Clear
           '************************
           ' For ii = 0 To A.Length - 1        '不知道table範圍在何處: 從0開始
           '******************************
            For ii = 11 To A.Length - 1        ''從11開始 用 Debug.Print ii  找出所要資料的table範圍
                For i = 0 To A(ii).Rows.Length - 1      '寫入資料
                'Debug.Print ii  可找出所要資料的 table 範圍
                k = k + 1
                For j = 0 To 5
                    Cells(k, j + 1) = A(ii).Rows(i).Cells(j).innerText
                Next
            Next
            Next
            .Range("C5").Cut Range("D5")
            With .Range("B5:C5,D5:E5")
                .HorizontalAlignment = xlCenter
                .VerticalAlignment = xlCenter
                .Merge
            End With
        End With
        .Quit        '關閉網頁
    End With
Next DQ
End Sub

TOP

cji3cj6xu6

帖子
112 
主題
19 
精華
0 
積分
136 
點名
0  
作業系統
window 
軟體版本
excel 
閱讀權限
20 
性別
男 
註冊時間
2013-3-12 
最後登錄
2022-11-29 

論壇贊助勳章
10#
發表於 2013-5-22 23:13 | 只看該作者
Dear G大，

我找到問題了。
謝謝您送的這個武器，好用。
因為K值會遞增所影響，所以多加一行K=0即可。

For DQ = 1 To 5
    DQQ = 6
    Sheets(DQQ).Select
     co_id = Range("A" & DQ).Value
    Sheets(DQ).Select
    isnew = 1
    k = 0
    ...........
   Next DQ

TOP

        靜思自在 : 【時間無法遮擋】怕時間消逝，花了許多心血，想盡各式方法要遮擋時間，結果是：浪費了更多時間，且一無所成！
12
返回列表 上一主題