返回列表 上一主題 發帖

[發問] EXCEL VBA抓資料(非表單)

GBKEE

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

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2016-7-1 18:16 | 顯示全部帖子
回復 2# super16666

試試看
  1. Option Explicit
  2. Sub Ex() '境外結構型商品資訊觀測站(資訊公告平台)
  3.     Dim E As Variant, Sh As Worksheet, xRow As Double, xTable As Object, xTable_Msg As Boolean
  4.     Dim i As Integer, xPag As Integer, xPag_All As Integer, xR As Integer, xC As Integer
  5.     Set Sh = ActiveSheet
  6.     Sh.Cells.Clear
  7.     With CreateObject("InternetExplorer.Application")
  8.         .Visible = True
  9.         .Navigate "http://structurednotes-announce.tdcc.com.tw/Snoteanc/apps/bas/BAS210.jsp"
  10.         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  11.         For i = 1 To .Document.all("AGENT_CODE").Length - 1
  12.             .Document.all("AGENT_CODE")(i).Selected = True
  13.             For Each E In .Document.all.tags("INPUT")
  14.                 If E.Type = "button" And E.Value = "查詢" Then E.Click   '' input type="button" value="查詢"
  15.             Next
  16.             Do While .Busy Or .readyState <> 4: DoEvents: Loop
  17.             xRow = xRow + 1
  18.             Sh.Range("a" & xRow) = .Document.all("AGENT_CODE")(i).innertext
  19.             If InStr(.Document.body.innertext, "所輸入之查詢條件查無相關的資料") Then
  20.                 xRow = xRow + 1
  21.                 Sh.Range("a" & xRow) = "查無相關的資料"
  22.             Else
  23.                 xPag_All = 1
  24.                 For Each E In .Document.all.tags("img")
  25.                    If InStr(E.href, "fp.gif") Then
  26.                         E.onclick              '前往 第一頁 的按鍵
  27.                         Do While .Busy Or .readyState <> 4: DoEvents: Loop
  28.                         Exit For
  29.                     End If
  30.                 Next
  31.                 For Each E In .Document.all.tags("img")
  32.                    If InStr(E.href, "lp.gif") Then
  33.                         xPag_All = Split(E.onclick, "'")(1) '往最後一頁按鍵: 讀取(總頁數)
  34.                         Exit For
  35.                     End If
  36.                 Next
  37.                 xTable_Msg = True
  38.                 xPag = 0
  39.                 Do
  40.                     '**********測試查看比對所下載頁數資料**********
  41.                     xRow = xRow + 1
  42.                     Sh.Range("a" & xRow) = .Document.all("AGENT_CODE")(i).innertext & " 下載 第 " & xPag + 1 & " 頁 共 " & xPag_All & " 頁"
  43.                     Sh.Range("a" & xRow).Select
  44.                     '***********無誤後 程式碼可註解掉*******************************
  45.                     Application.StatusBar = .Document.all("AGENT_CODE")(i).innertext & " 下載  第  " & xPag + 1 & " 頁 共 " & xPag_All & " 頁"
  46.                     Do While .Busy Or .readyState <> 4: DoEvents: Loop
  47.                     Set xTable = .Document.all.tags("TABLE")(2)
  48.                     For xR = IIf(xTable_Msg, 0, 2) To xTable.Rows.Length - 1
  49.                         xRow = xRow + 1
  50.                         For xC = 0 To xTable.Rows(xR).Cells.Length - 1
  51.                             Sh.Cells(xRow, xC + 1) = IIf(xC = 0, "'", "") & xTable.Rows(xR).Cells(xC).innertext
  52.                         Next
  53.                     Next
  54.                     xTable_Msg = False
  55.                     For Each E In .Document.all.tags("img")
  56.                         If InStr(E.href, "np.gif") Then E.Click
  57.                     Next
  58.                     xPag = xPag + 1
  59.                 Loop Until xPag_All = xPag
  60.             End If
  61.     Next
  62.         .Quit        '關閉網頁
  63.     End With
  64.     Application.StatusBar = " 下載   Ok"
  65. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 閒人無樂趣，忙人無是非。
返回列表 上一主題