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