標題:
[發問]
EXCEL VBA抓資料(非表單)
[打印本頁]
作者:
super16666
時間:
2016-6-25 22:10
標題:
EXCEL VBA抓資料(非表單)
本帖最後由 super16666 於 2016-6-25 22:11 編輯
想問怎樣抓下面的資料，我是在TDCC境外平台 (http://structurednotes-announce.tdcc.com.tw/Snoteanc/)
因為論文需要，想要一口氣抓下方所有的資料(如下圖)，可是這個真的太多了...
如圖：
進去網站之後，點左側"商品總覽"→"發行人/總代理人"
我想要一口氣把所有"發行人/總代理人"下方的表格都下載下來
如圖：
可是有兩個困難點
1. 第一個就是從EXCEL的時候，如果我直接COPY網址，他只會連到這個首頁...這樣子就不能直接抓表格...
2. 就是他的頁碼介面很不友善，只能一頁一頁點，也要點到最後一頁才知道總共有幾頁，而且假設你要到第十頁只能一頁一頁點...
如圖：
想問問看有沒有大神可以一口氣下載全部資料...
救救小妹我的論文QQ
目前有網友是建議用createobject("internetexplorer.application")，不過我已經嘗試好久了真的弄不太出來，有人可以稍微指點一下嗎?
謝謝Q_Q 救救我的論文...真的不行就只能一個一個點了...
作者:
super16666
時間:
2016-6-26 13:19
目前我已經摸索出來怎樣選出發行人 和 按下查詢的按鈕了
現在卡在下面兩點:
1. 得知總共頁數有幾頁
2. 如何換頁
有找到網頁原始碼的位置了，如下：
-------------------------------------
<img src="/Snoteanc/images/fp.gif" style="border:none"
onClick="setPage('1')">
<img src="/Snoteanc/images/ppn.gif" style="border:none"
onClick="setPage('1')">
<strong><font size="2">1</font></strong>
<img src="/Snoteanc/images/np.gif" style="border:none"
onClick="setPage('2')">
<img src="/Snoteanc/images/lp.gif" style="border:none"
onClick="setPage('46')">
function setPage(p){
form.ORDER_BY.value = 'FUND_NAME';
var asc = '0';
if(asc == '1'){
asc = "0";
}
else{
asc = '1';
}
form.IS_ASC.value = asc;
form.currentPage.value = p;
checkBeforeSubmit();
}
-------------------------------------
QQ
作者:
GBKEE
時間:
2016-7-1 18:16
回復
2#
super16666
試試看
Option Explicit
Sub Ex() '境外結構型商品資訊觀測站(資訊公告平台)
Dim E As Variant, Sh As Worksheet, xRow As Double, xTable As Object, xTable_Msg As Boolean
Dim i As Integer, xPag As Integer, xPag_All As Integer, xR As Integer, xC As Integer
Set Sh = ActiveSheet
Sh.Cells.Clear
With CreateObject("InternetExplorer.Application")
.Visible = True
.Navigate "http://structurednotes-announce.tdcc.com.tw/Snoteanc/apps/bas/BAS210.jsp"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
For i = 1 To .Document.all("AGENT_CODE").Length - 1
.Document.all("AGENT_CODE")(i).Selected = True
For Each E In .Document.all.tags("INPUT")
If E.Type = "button" And E.Value = "查詢" Then E.Click '' input type="button" value="查詢"
Next
Do While .Busy Or .readyState <> 4: DoEvents: Loop
xRow = xRow + 1
Sh.Range("a" & xRow) = .Document.all("AGENT_CODE")(i).innertext
If InStr(.Document.body.innertext, "所輸入之查詢條件查無相關的資料") Then
xRow = xRow + 1
Sh.Range("a" & xRow) = "查無相關的資料"
Else
xPag_All = 1
For Each E In .Document.all.tags("img")
If InStr(E.href, "fp.gif") Then
E.onclick '前往 第一頁 的按鍵
Do While .Busy Or .readyState <> 4: DoEvents: Loop
Exit For
End If
Next
For Each E In .Document.all.tags("img")
If InStr(E.href, "lp.gif") Then
xPag_All = Split(E.onclick, "'")(1) '往最後一頁按鍵: 讀取(總頁數)
Exit For
End If
Next
xTable_Msg = True
xPag = 0
Do
'**********測試查看比對所下載頁數資料**********
xRow = xRow + 1
Sh.Range("a" & xRow) = .Document.all("AGENT_CODE")(i).innertext & " 下載 第 " & xPag + 1 & " 頁 共 " & xPag_All & " 頁"
Sh.Range("a" & xRow).Select
'***********無誤後 程式碼可註解掉*******************************
Application.StatusBar = .Document.all("AGENT_CODE")(i).innertext & " 下載 第 " & xPag + 1 & " 頁 共 " & xPag_All & " 頁"
Do While .Busy Or .readyState <> 4: DoEvents: Loop
Set xTable = .Document.all.tags("TABLE")(2)
For xR = IIf(xTable_Msg, 0, 2) To xTable.Rows.Length - 1
xRow = xRow + 1
For xC = 0 To xTable.Rows(xR).Cells.Length - 1
Sh.Cells(xRow, xC + 1) = IIf(xC = 0, "'", "") & xTable.Rows(xR).Cells(xC).innertext
Next
Next
xTable_Msg = False
For Each E In .Document.all.tags("img")
If InStr(E.href, "np.gif") Then E.Click
Next
xPag = xPag + 1
Loop Until xPag_All = xPag
End If
Next
.Quit '關閉網頁
End With
Application.StatusBar = " 下載 Ok"
End Sub
複製代碼
歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)
