返回列表 上一主題 發帖

[發問] 網路資料下載問題，

wahaha6666

帖子
2 
主題
1 
精華
0 
積分
1 
點名
0  
作業系統
Windows 
軟體版本
7 
閱讀權限
10 
註冊時間
2014-11-20 
最後登錄
2014-12-8 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2014-11-20 22:11 | 只看該作者

[發問] 網路資料下載問題，

本帖最後由 GBKEE 於 2014-11-21 17:14 編輯

GBKEE大大，之前有看您幫助解決在公開資訊觀測站抓資料的文

我需要抓取公司的財務資料(網址如下)

http://mops.twse.com.tw/mops/web/t164sb04

透過GBKEE大大的指導，我可以用VBA Excel抓到非金融公司的資料(程式碼如下)

        Dim Ie, Doc As Object, i, j As Long

        Set Ie = CreateObject("InternetExplorer.Application")
   
        With Ie
   
        Ie.Navigate "http://mops.twse.com.tw/mops/web/t164sb04"
   
        Ie.Visible = True
   
           Do While Ie.Busy Or Ie.ReadyState <> 4: DoEvents: Loop

        .Document.getelementbyID("isnew").Value = "true"    '最新資料 = true, 歷史資料 = false
        .Document.getelementbyID("co_id").Value = "2888"    '股票代號
        .Document.getelementbyID("year").Value = Year        '年度
        .Document.getelementbyID("season").Value = Quarter   '第一季 = 01, 第二季 = 02, 第三季 = 03, 第四季 = 04
        
        For i = 0 To .Document.getElementsByTagName("input").Length - 1
            
            If .Document.getElementsByTagName("input")(i).Type = "button" And .Document.getElementsByTagName("input")(i).Value = " 搜尋 " Then
               
                .Document.getElementsByTagName("input")(i).Click
            
            End If
        
        Next


但碰到要下載金融公司的財報就卡住了，我不管怎試，就是進不到第2層(如下畫面)

上面的程式碼不會直接跑出財報，只會列出金融公司相關公司資訊。必須再次點選"詳細資料"才能叫出財報資料

[attach]19616[/attach]




不知道GBKEE大大能否幫忙看一下

感恩
收藏 分享

HSIEN6001

帖子
219 
主題
24 
精華
0 
積分
243 
點名
0  
作業系統
Windows10 
軟體版本
Office2016 
閱讀權限
20 
性別
女 
註冊時間
2012-4-18 
最後登錄
2022-2-7 

論壇榮譽勳章論壇贊助勳章
2#
發表於 2014-11-20 23:47 | 只看該作者
本帖最後由 HSIEN6001 於 2014-11-20 23:52 編輯

回復 1# wahaha6666

何不直接抓合併報表,不用一檔一檔抓
    http://mops.twse.com.tw/mops/web/t163sb04 (已包含銀行股)

PS: 剛剛看內容比較詳細 ,  ((請忽略我的建議 :))

TOP

HSIEN6001

帖子
219 
主題
24 
精華
0 
積分
243 
點名
0  
作業系統
Windows10 
軟體版本
Office2016 
閱讀權限
20 
性別
女 
註冊時間
2012-4-18 
最後登錄
2022-2-7 

論壇榮譽勳章論壇贊助勳章
3#
發表於 2014-11-21 00:17 | 只看該作者
本帖最後由 HSIEN6001 於 2014-11-21 00:18 編輯

回復 1# wahaha6666
也是參考GBKEE大大的Code
試試,有符合需求?!
  1. Dim 網頁 As Object

  3. Sub 半自動()
  4.     Dim i As Integer, K As Integer, ii, J
  5.     Dim path As String
  6.     path = "C:\Stock\"

  8.     '程式第一次執行: 打開網頁,在網頁中手動選擇資料後  , 按[總行]or[選定分行] ; 有資料的,執行第2次下載後會自動關閉網頁
  9.     '程式第二次執行: 讀取網頁資料到 Excel中.   (有出現table資料表的,再按一次執行程式則會下載檔案至目標)
  10.    
  11. 年度 = "103"
  12. 季期 = "3"
  13. 代號 = "2880"
  14.    
  15.    
  16. On Error GoTo RE網頁

  18. 1:
  19.     If 網頁 Is Nothing Then
  20.         Set 網頁 = CreateObject("InternetExplorer.Application")
  21.             With 網頁
  22.                 .Visible = True
  23.                 .navigate "http://mops.twse.com.tw/mops/web/t164sb04?encodeURIComponent=1&step=1&firstin=ture&off=1&keyword4=&code1=&TYPEK2=&checkbtn=&queryName=co_id&TYPEK=all&isnew=false&co_id=" & 代號 & "&year=" & 年度 & "&season=" & 季期
  24.                 .Height = 500
  25.                 .Width = 1050
  26.             End With

  28.         Exit Sub
  29.     End If
  30.     If 網頁.Visible = False Then
  31.        網頁.Value = True
  32.         Exit Sub
  33.     End If

  35.     '**********讀取網頁 資料 *******************
  36.     Set A = 網頁.document.getElementsByTagName("table")
  37.          With Workbooks.Add
  38.             On Error Resume Next
  39.                '************************
  40.                ' For ii = 0 To A.Length - 1        '不知道table範圍在何處: 從0開始
  41.                '************************
  42.                 For ii = 11 To A.Length - 1
  43.                     For i = 0 To A(ii).Rows.Length - 1

  45.                         K = K + 1
  46.                         For J = 0 To 8
  47.                             Cells(K, J + 1) = A(ii).Rows(i).Cells(J).innerText
  48.                         Next
  49.                     Next
  50.                 Next
  51.             '
  52.             If Dir(path & 代號 & ".xls") <> "" Then Kill (path & 代號 & ".xls")
  53.             ActiveWorkbook.SaveAs Filename:=path & 代號 & ".xls"
  54.             ActiveWindow.Close
  55.         End With
  56.     Set A = Nothing
  57.     網頁.Quit    '打開的網頁,再次執行後會自動下載有table的資料,完成下載後,自動關閉已下載完成的IE網頁
  58.     Exit Sub
  59. RE網頁:
  60.     Set 網頁 = Nothing
  61.    Resume 1
  62. End Sub
複製代碼

TOP

wahaha6666

帖子
2 
主題
1 
精華
0 
積分
1 
點名
0  
作業系統
Windows 
軟體版本
7 
閱讀權限
10 
註冊時間
2014-11-20 
最後登錄
2014-12-8 
4#
發表於 2014-11-21 21:00 | 只看該作者
還是沒辦法。就會卡在這一頁。進不去財務資訊業面


公司代號

公司名稱


2880 華南金  
28800001 華南銀行  
28800002 華南永昌  
28800004 華南保  
28800005 華南投信   
28800006 華南金創   
28800007 華南金管   
28800008 華南金資   
28800009 華銀保代   
28800010 華南投顧   
28800012 華永香港   
28800013 華永資管

TOP

HSIEN6001

帖子
219 
主題
24 
精華
0 
積分
243 
點名
0  
作業系統
Windows10 
軟體版本
Office2016 
閱讀權限
20 
性別
女 
註冊時間
2012-4-18 
最後登錄
2022-2-7 

論壇榮譽勳章論壇贊助勳章
5#
發表於 2014-11-22 00:13 | 只看該作者
回復 4# wahaha6666
我執行沒問題喔! 可能你沒有搞懂流程
(針對有資料去執行,沒資料的直接關閉網頁,重新程序)

(1)執行程式 (第1次開啟網頁)
(2)網業開啟後......28800001要按下去,才會打開資料內容   (目前2880沒資料,點下去,沒資料就關閉網頁再重新程序)
(3)執行程式(第2次下載網頁表格)
(4)已經下載完成,並關閉網頁.

財報.rar (11.59 KB)

TOP

GBKEE

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

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

回復 5# HSIEN6001
試試看
  1. Dim 網頁 As Object, Ar1 As String, xPath As String
  2. Sub EX_自動()
  3.     Dim i As Integer, k As Integer, AR() As String, j As Integer
  4.     xPath = "d:\"      '存檔位置,自己修正一下
  5.     Ar1 = ""
  6.     年度 = "103"
  7.     季期 = "3"
  8.     代號 = "2880"
  9.     Set 網頁 = CreateObject("InternetExplorer.Application")
  10.     With 網頁
  11.         '.Visible = True
  12.         .Navigate "http://mops.twse.com.tw/mops/web/t164sb04?'encodeURIComponent=1&step=1&firstin=ture&off=1&keyword4=&code1=&TYPEK2=&checkbtn=&queryName=co_id&TYPEK=all&isnew=false&co_id=" & 代號 & "&year=" & 年度 & "&season=" & 季期
  13.                
  14.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  15.         If InStr(.Document.body.innertexT, "查無公司資料") Then
  16.             MsgBox 代號 & "  : 查無公司資料!"
  17.             .Quit
  18.             End
  19.         End If
  20.         '****************   讀取 金控股子公司名稱
  21.         With .Document.getElementsByTagName("TABLE")(11)
  22.             ReDim AR(1 To .Rows.Length - 1)
  23.             For i = 1 To .Rows.Length - 1
  24.                 For j = 0 To .Rows(i).Cells.Length - 2
  25.                     AR(i) = AR(i) & IIf(AR(i) <> "", "-", "") & .Rows(i).Cells(j).innertexT
  26.                 Next
  27.             Next
  28.         End With
  29.         '*****************************
  30.         Set A = .Document.getElementsByTagName("INPUT")
  31.         i = 1
  32.         For E = 0 To A.Length - 1
  33.             If A(E).Value = "詳細資料" And A(E).Type = "button" Then
  34.                 A(E).Click   '有"詳細資料" 金控股子公司的按鈕
  35.                 Do While 網頁.Busy Or 網頁.readyState <> 4: DoEvents: Loop
  36.                 If InStr(.Document.body.innertexT, "查無") = 0 Then  '金控股子公司有資料
  37.                     IE_Table AR(i)  '參數傳遞:金控股子公司的名稱
  38.                 End If
  39.                 For Each Img In .Document.getElementsByTagName("img")
  40.                         'http://mops.twse.com.tw/mops/web/images/bu_05.gif 回上頁的圖片
  41.                     If Img.href = "http://mops.twse.com.tw/mops/web/images/bu_05.gif" Then
  42.                         Img.Click
  43.                         Do While 網頁.Busy Or 網頁.readyState <> 4: DoEvents: Loop
  44.                         Exit For
  45.                     End If
  46.                 Next
  47.                 i = i + 1 '下一個 金控股子公司
  48.             End If
  49.         Next
  50.         .Quit
  51.     End With
  52.     MsgBox Ar1 & vbLf & "存檔 " & UBound(Split(Ar1, vbLf)) + 1 & " 個   完畢", , AR(1)
  53. End Sub
  54. Private Sub IE_Table(co_id As String)
  55.     Dim A As Object, i, k, j
  56.     Do
  57.      Set A = 網頁.Document.getElementsByTagName("table") '(12)
  58.     Loop Until Not A Is Nothing And A.Length >= 14
  59.     Set A = A(12)
  60.     With Workbooks.Add(1)
  61.         For i = 0 To A.Rows.Length - 1
  62.             k = k + 1
  63.             For j = 0 To A.Rows(i).Cells.Length - 1
  64.                 .Sheets(1).Cells(k, j + 1) = A.Rows(i).Cells(j).innertexT
  65.             Next
  66.         Next
  67.         If Dir(xPath & co_id & ".xls") <> "" Then Kill (xPath & co_id & ".xls")
  68.         .SaveAs Filename:=xPath & co_id & ".xls"
  69.         .Close
  70.     End With
  71.     Ar1 = Ar1 & IIf(Ar1 <> "", vbLf, "") & co_id
  72. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

HSIEN6001

帖子
219 
主題
24 
精華
0 
積分
243 
點名
0  
作業系統
Windows10 
軟體版本
Office2016 
閱讀權限
20 
性別
女 
註冊時間
2012-4-18 
最後登錄
2022-2-7 

論壇榮譽勳章論壇贊助勳章
7#
發表於 2014-11-23 22:54 | 只看該作者
回復 6# GBKEE

    太好了!!不用點選就完成 (謝謝!!
我得慢慢研究~研究~  ^^!!

TOP

        靜思自在 : 要批評別人時，先想想自己是否完美無缺。
返回列表 上一主題