返回列表 上一主題 發帖

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

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 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

        靜思自在 : 欣賞別人就是莊嚴自己。
返回列表 上一主題