麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] [EXCEL VBA] 這網頁怎麼抓呢? [打印本頁]

作者: Hunt01 時間: 2016-1-4 15:55 標題: [EXCEL VBA] 這網頁怎麼抓呢?

本帖最後由 Hunt01 於 2016-1-4 15:57 編輯

大家好

小弟 VBA 一路學來，始終裡裡落落，老是抓不到要領

現在小弟希望練習抓以下網頁，將之下載成表。
可是.....詳細資料那欄的連結要怎麼抓呢?

各位專家大若不易說明，簡單提點一下參考那些資料或關鍵字，亦十分感激，小弟會用心去找資料的

謝謝大家!!

網址: http://mops.twse.com.tw/mops/web/t05sr01_1
畫面: [attach]23039[/attach]

作者: joey0415 時間: 2016-1-4 20:26

回復 1# Hunt01

http://club.excelhome.net/thread-874608-1-1.html

這方法用點擊法，翻轉更面後，將頁面記錄下來

另外一種是
http://club.excelhome.net/thread-1159783-1-1.html

xmlhttp法，找到post資料抓下來分析

我自己試寫了花了好長一段時間才寫出類出的內容

作者: Hunt01 時間: 2016-1-5 22:46

本帖最後由 Hunt01 於 2016-1-5 22:47 編輯

回復 2# joey0415

十分感謝 joey0415 大!
小弟興奮地前往連結，結果入寶山，空手回，冏~~

原因是該寶山太強大，整座金山，但小弟弱雞一個，除了金光閃閃好刺眼，接下來就有看沒有懂，敲不下半個金屑...

我胡亂比劃地試著用 joey0415 大所建議的 xmlhttp 法，找到 post 資料抓下來分析。首先用 Fiddler 將資料抓下來分析，Fiddler 抓出來的碼看來與原始網頁碼相近，可能是觀測站的資料較簡單的關係吧。

我以鴻海為例，它的原始碼如下:

<td style='text-align:left !important;' nowrap>鴻海</td>
<td style='text-align:left !important;'>105/01/05</td>
<td style='text-align:left !important;'>11:41:00</td>
<td style='text-align:left !important;'>說明媒體報導</td>
<td><input type='button' value='詳細資料' onclick="document.fm_t05sr01_1.SEQ_NO.value='1';document.fm_t05sr01_1.SPOKE_TIME.value='114100';document.fm_t05sr01_1.SPOKE_DATE.value='20160105';document.fm_t05sr01_1.COMPANY_NAME.value='?E??';document.fm_t05sr01_1.COMPANY_ID.value='2317';document.fm_t05sr01_1.skey.value='2317201601051';document.fm_t05sr01_1.hhc_co_name.value='?E??';ajax1(this.form,'table01');">
[attach]23047[/attach]

看起來是 javascript(我也不懂，冏)?
怎麼用 vba 來處理這好兇的原始碼呢?

謝謝大大們解答弱弱的小弟

作者: stillfish00 時間: 2016-1-6 10:47

回復 3# Hunt01
onclick 後設定了一堆值，然後呼叫 ajax1
你要分析就要再去找網頁中的這個 ajax1 function的內容
它裡面會再向另一個網頁POST請求，post 參數來自剛剛設定那些值。
所以你要從
"document.fm_t05sr01_1.SEQ_NO.value='1';document.fm_t05sr01_1.SPOKE_TIME.value='114100';document.fm_t05sr01_1.SPOKE_DATE.value='20160105';document.fm_t05sr01_1.COMPANY_NAME.value='?E??';document.fm_t05sr01_1.COMPANY_ID.value='2317';document.fm_t05sr01_1.skey.value='2317201601051';document.fm_t05sr01_1.hhc_co_name.value='?E??';ajax1(this.form,'table01');"

這字串中提取出你要的參數，再用 xmlhttp 向另一個網頁POST請求，

作者: Hunt01 時間: 2016-1-11 17:13

本帖最後由 Hunt01 於 2016-1-11 17:16 編輯

非常感謝 joey0415 以及 stillfish00 大大的指導 :$
小弟利用上週及假日胡亂摸索，初步只大概會用 onclick 來達到目的, xmlhttp 後續再接再勵。
不過奇怪的是，小弟 VBA click 時，好像會因為網頁 refresh 不及而造成後續抓取資料步驟產生錯誤。我有加入 do loop 來等待，不過看來這個 do loop 無作用。
大大們有建議的處理方法嗎?
附上小弟拙劣的 code 供參考。
謝謝大家!!!!

Dim IE As New InternetExplorer
IE.Visible = True

'重大訊息公佈網頁
IE.Navigate "http://mops.twse.com.tw/mops/web/t05sr01_1"
Do: DoEvents: Loop Until IE.readyState = READYSTATE_COMPLETE
Dim doc As HTMLDocument
Set doc = IE.document

'按下"詳細資料" button
Set docinput = doc.getElementsByTagName("input")
r = 1
For i = 0 To docinput.Length - 1
      If docinput(i).Value = "詳細資料" And docinput(i).Type = "button" Then

'???按下"詳細資料"button, 有時有問題???
         docinput(i).Click
         Do: DoEvents: Loop Until IE.readyState = READYSTATE_COMPLETE

'進入"詳細資料"頁面後，開始抓取主要內容。主要訊息內容為 table(9)
         Set A = doc.getElementsByTagName("table")(9)
         Do: DoEvents: Loop Until IE.readyState = READYSTATE_COMPLETE

'將主要訊息內容放入 sheet
         For j = 1 To A.Rows(4).Cells.Length - 1
            Sheets(1).Cells(r, j + 1).Select
            Sheets(1).Cells(r, j + 1).Value = A.Rows(4).Cells(j).innerText
         Next j
         r = r + 1

'抓完訊息內容後，返回上一頁
         For Each img In doc.getElementsByTagName("img")
            If img.href = "http://mops.twse.com.tw/mops/web/images/bu_05.gif" Then

'???img.click 有時無動作???
                  img.Click
                  Do: DoEvents: Loop Until IE.Busy = False And IE.readyState = READYSTATE_COMPLETE
                  Exit For
            End If
         Next
      End If
Next i
IE.Quit

作者: stillfish00 時間: 2016-1-12 15:53

本帖最後由 stillfish00 於 2016-1-12 16:05 編輯

回復 5# Hunt01
by xmlhttp

Sub Test()
Dim oXmlhttp As Object: Set oXmlhttp = CreateObject("msxml2.xmlhttp")
Dim oRegexp As Object: Set oRegexp = CreateObject("vbscript.regexp")
Dim oHtmldoc As Object: Set oHtmldoc = CreateObject("htmlfile")
Dim oClip As Object: Set oClip = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}") 'or DataObject
With oXmlhttp
.Open "GET", "http://mops.twse.com.tw/mops/web/t05sr01_1", False
.Send
oHtmldoc.write .responseText
End With
Dim oTable As Object, oRow As Object, sParse As String, sPost As String
Set oTable = oHtmldoc.getelementbyid("table01").getelementsbytagname("form")(1).getelementsbytagname("table")(0)
sParse = oTable.Rows(1).Cells(5).innerhtml '只取第一行詳細資料
With oRegexp
.Pattern = ".*?SEQ_NO\.value='(.*?)'" & _
".*?SPOKE_TIME\.value='(.*?)'" & _
".*?SPOKE_DATE\.value='(.*?)'" & _
".*?COMPANY_ID\.value='(.*?)'" & _
".*?skey\.value='(.*?)'.*"
sPost = .Replace(sParse, "encodeURIComponent=1&TYPEK=all&step=1&skey=$5&COMPANY_ID=$4&SPOKE_DATE=$3&SPOKE_TIME=$2&SEQ_NO=$1")
End With
With oXmlhttp
.Open "POST", "http://mops.twse.com.tw/mops/web/ajax_t05sr01_1", False
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.SetRequestHeader "Content-Length", Len(sPost)
.Send (sPost)
oHtmldoc.Close 'Set oHtmldoc = CreateObject("htmlfile")
oHtmldoc.write .responseText
End With
With oClip
.SetText oHtmldoc.body.innerhtml
.PutInClipboard
End With
Sheets.Add().PasteSpecial NoHTMLFormatting:=True
End Sub

複製代碼

作者: Hunt01 時間: 2016-1-14 14:33

stillfish00 大大:

你太強大了，由衷感謝你撥冗提供此範例 code!

小弟目前已會使用 click 方式來達成，只是有時不知為何 click 會失敗，目前想到的方法為判斷若網頁 click 失敗(沒更新)，就不停地 click, 直到更新為止。

大大所提供之 xmlhttp 範例小弟會再花時間好好研讀，弱弱的我可能又得花好幾星期消化它了，哈。
再次感謝大大!!

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)