最新消息

[公告2014/05/30] 如有需要將部落格中,任何一篇文章的程式碼使用在商業用途,請與我聯繫。

[公告2015/04/26] Line版的 iInfo程式與投資應用 群組已上線想加入的朋友們,請先查看 "入群須知" 再與我聯繫 Line : aminwhite5168,加入請告知身分與回答 "入群須知" 的問題。

[公告2018/04/22] 台北 Python + Excel VBA 金融資訊爬蟲課程,課程如網頁內容 金融資訊爬蟲班:台北班 Python 金融資訊爬蟲、EXCEL VBA 金融資訊爬蟲

[公告2019/01/08] 請注意:我再次重申,部落格文章的程式碼,是要提供各位參考與學習,一旦網頁改版請自行修改,別要求東要求西要我主動修改,你們用我寫東西賺錢了、交差了,請問有分我一杯羹嗎?既然賺錢沒分我,請問有什麼理由要求我修改,如果沒能力改,就花錢來找我上課。

[公告2019/12/01] 若各位有 Excel VBA 案子開發需求,歡迎與我聯繫,可接案處理。

[公告2020/05/22] 頁面載入速度慢,起因為部分JS來源(alexgorbatchev.com)失效導致頁面載入變慢,目前已做調整,請多見諒。

2012年8月19日 星期日

Excel VBA抓元大寶來100網頁


近期處理一個想透過VBA抓取網頁表格數據的問題,http://www.p-shares.com/0051-4-1-1.asp 該網頁屬於元大寶來投信的網頁,網頁會亂碼的原因,可能受到網頁第8行word.css的影響,不過這還要再確認才知道。


當然各位可以將網頁的編碼設為UTF-8,即可見到正常的網頁資訊,不過這還不是最頭痛的問題,我在猜這個網頁撰寫人很喜歡用換行符號”\r\n”(就是DOS/Windows的換行0D0A),所以在表格數據每個欄位都加入換行符號,導致無法使用Trim函數,相對的這也考驗程式開發者的敏感度與對文件的熟析程度。


透過 Fiddler 工具抓出從網頁抓下來在Memory的中所呈現的16進制的數據,以下將網頁表格數據中的其中一個欄位節錄出來,如下紅色框框即是網頁資料的真實數據。


基於以上的分析再透過VBA的語法,即可取得亂碼資料的問題。

Option Explicit

Sub 寶來100()
    Dim oXMLHTTP As Object
    Dim objStream As Object
    Dim i As Integer, j As Integer, Rowstart As Integer
    Dim Webbadydata() As String, Webheader() As String, WebPageData As String
    Dim tmep As String
        
    '設定XMLHTTP與ADODB物件
    Set oXMLHTTP = CreateObject("Msxml2.XMLHTTP")
    Set objStream = CreateObject("ADODB.Stream")
    
    '使用UTF8,取得網頁資料
    With oXMLHTTP
        .Open "GET", "http://www.p-shares.com/0051-4-1-1.asp", False
        .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
        .send
        If .Status = 200 Then               '網頁請求成功
            With objStream
                .Open
                .WriteText oXMLHTTP.ResponseBody
                .Position = 0               '從頭開始
                .Type = 2                   '以文字模式操作(adTypeText),用以text/ntext欄位保存純文本資料,另有二進位方式操作adTypeBinary
                .Charset = "Big5"          'UTF-8編碼(近期網頁有修改,請以Big5編碼)
                WebPageData = .ReadText     '取得主要資料欄位
                .Close
            End With
        Else
            MsgBox "無法取得資料"
        End If
        '釋放資源
        Set objStream = Nothing
    End With
    
    '釋放資源
    Set oXMLHTTP = Nothing

    MsgBox WebPageData
    Sheets("Sheet1").Select
    Webheader = Split(WebPageData, "<th class=""" & "word12" & """>") '取得header說明
    For i = 1 To UBound(Webheader)
        Cells(1, i) = Trim(Split(Mid(Webheader(i), 3, Len(Webheader(i))), "</th>")(0)) '先去除\r\n,再去除空白
    Next
    
    '對不需要資料先做刪除
    Webbadydata = Split(WebPageData, "<tr align=" & """center""" & " bgcolor=" & """#DDE4EE""" & " class=" & """word""" & ">") '去頭
    Webbadydata = Split(Webbadydata(1), "<tr align=" & """center""" & " bgcolor=" & """#E4DFFF""" & ">") '去尾
    Webbadydata = Split(Webbadydata(0), "<td>") '開始取值
    
    Rowstart = 2
    For i = 1 To UBound(Webbadydata) Step 3
        For j = 0 To 2
            tmep = Trim(Mid(Webbadydata(i + j), 3, Len(Webbadydata(i + j)))) '對0D0A進行刪除並去除空白
            Cells(Rowstart, j + 1) = Trim(StrReverse(Mid(StrReverse(Trim(Split(tmep, "</td>")(0))), 3, Len(StrReverse(Trim(Split(tmep, "</td>")(0))))))) '對0D0A進行刪除並去除空白
        Next
        Rowstart = Rowstart + 1
    Next
End Sub

沒有留言:

張貼留言