- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
6#
發表於 2014-11-23 15:39
| 只看該作者
本帖最後由 GBKEE 於 2014-11-23 16:02 編輯
回復 5# HSIEN6001
試試看- Dim 網頁 As Object, Ar1 As String, xPath As String
- Sub EX_自動()
- Dim i As Integer, k As Integer, AR() As String, j As Integer
- xPath = "d:\" '存檔位置,自己修正一下
- Ar1 = ""
- 年度 = "103"
- 季期 = "3"
- 代號 = "2880"
- Set 網頁 = CreateObject("InternetExplorer.Application")
- With 網頁
- '.Visible = True
- .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=" & 季期
-
- Do While .Busy Or .readyState <> 4: DoEvents: Loop
- If InStr(.Document.body.innertexT, "查無公司資料") Then
- MsgBox 代號 & " : 查無公司資料!"
- .Quit
- End
- End If
- '**************** 讀取 金控股子公司名稱
- With .Document.getElementsByTagName("TABLE")(11)
- ReDim AR(1 To .Rows.Length - 1)
- For i = 1 To .Rows.Length - 1
- For j = 0 To .Rows(i).Cells.Length - 2
- AR(i) = AR(i) & IIf(AR(i) <> "", "-", "") & .Rows(i).Cells(j).innertexT
- Next
- Next
- End With
- '*****************************
- Set A = .Document.getElementsByTagName("INPUT")
- i = 1
- For E = 0 To A.Length - 1
- If A(E).Value = "詳細資料" And A(E).Type = "button" Then
- A(E).Click '有"詳細資料" 金控股子公司的按鈕
- Do While 網頁.Busy Or 網頁.readyState <> 4: DoEvents: Loop
- If InStr(.Document.body.innertexT, "查無") = 0 Then '金控股子公司有資料
- IE_Table AR(i) '參數傳遞:金控股子公司的名稱
- End If
- For Each Img In .Document.getElementsByTagName("img")
- 'http://mops.twse.com.tw/mops/web/images/bu_05.gif 回上頁的圖片
- If Img.href = "http://mops.twse.com.tw/mops/web/images/bu_05.gif" Then
- Img.Click
- Do While 網頁.Busy Or 網頁.readyState <> 4: DoEvents: Loop
- Exit For
- End If
- Next
- i = i + 1 '下一個 金控股子公司
- End If
- Next
- .Quit
- End With
- MsgBox Ar1 & vbLf & "存檔 " & UBound(Split(Ar1, vbLf)) + 1 & " 個 完畢", , AR(1)
- End Sub
- Private Sub IE_Table(co_id As String)
- Dim A As Object, i, k, j
- Do
- Set A = 網頁.Document.getElementsByTagName("table") '(12)
- Loop Until Not A Is Nothing And A.Length >= 14
- Set A = A(12)
- With Workbooks.Add(1)
- For i = 0 To A.Rows.Length - 1
- k = k + 1
- For j = 0 To A.Rows(i).Cells.Length - 1
- .Sheets(1).Cells(k, j + 1) = A.Rows(i).Cells(j).innertexT
- Next
- Next
- If Dir(xPath & co_id & ".xls") <> "" Then Kill (xPath & co_id & ".xls")
- .SaveAs Filename:=xPath & co_id & ".xls"
- .Close
- End With
- Ar1 = Ar1 & IIf(Ar1 <> "", vbLf, "") & co_id
- End Sub
|
|
發表於 2014-11-20 22:11
| 
