網抓後文字編碼問題

blanksoul12

Sub main() '主體代碼
    Dim strText As String
    Dim strcookie As String
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "POST", "http://www.hkexnews.hk/sdw/search/search_sdw_c.asp", False
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send "txt_today_d=28&txt_today_m=10&txt_today_y=2014&current_page=1&stock_market=HKEX&IsExist_Slt_Stock_Id=False&IsExist_Slt_Part_Id=False&rdo_SelectSortBy=Shareholding&sel_ShareholdingDate_d=27&sel_ShareholdingDate_m=10&sel_ShareholdingDate_y=2014&txt_stock_code=08056&txt_stock_name=&txt_ParticipantID=&txt_Participant_name="
        CopyToClipbox .responseText
    End With
End Sub

運行後可以得到相關資料,但當中的繁體字變成亂碼了,請問怎麼解決呢?

blanksoul12

Sub main() '主體代碼
    Dim strText As String
    Dim strcookie As String
    On Error Resume Next
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "POST", "http://www.hkexnews.hk/sdw/search/search_sdw_c.asp", False
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=big5"
        .send "txt_today_d=28&txt_today_m=10&txt_today_y=2014&current_page=1&stock_market=HKEX&IsExist_Slt_Stock_Id=False&IsExist_Slt_Part_Id=False&rdo_SelectSortBy=Shareholding&sel_ShareholdingDate_d=27&sel_ShareholdingDate_m=10&sel_ShareholdingDate_y=2014&txt_stock_code=08056&txt_stock_name=&txt_ParticipantID=&txt_Participant_name="
        CopyToClipbox BytesToBstr(.responseBody, "BIG5")
     End With
End Sub
Function BytesToBstr(strBody, CodeBase)                        '使用Adodb.Stream?象提取字符串
    Dim objStream
    On Error Resume Next
    Set objStream = CreateObject("Adodb.Stream")
    With objStream
        .Type = 1
        .Mode = 3
        .Open
        .write strBody
        .Position = 0
        .Type = 2
        .Charset = CodeBase
        BytesToBstr = .ReadText
    End With
    objStream.Close
    Set objStream = Nothing
    If Err.Number <> 0 Then BytesToBstr = ""
    On Error GoTo 0
End Function

想問問,中間那句 CopyToClipbox BytesToBstr(.responseBody, "BIG5") 如果變成 CopyToClipbox BytesToBstr(.responseText, "BIG5") 這樣便拿不到內文,請問是什麼問題呢?

blanksoul12

Sub main() '主體代碼
    On Error Resume Next
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "POST", "http://www.hkexnews.hk/sdw/search/search_sdw_c.asp", False
        .SetRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send "txt_today_d=28&txt_today_m=10&txt_today_y=2014&current_page=1&stock_market=HKEX&IsExist_Slt_Stock_Id=False&IsExist_Slt_Part_Id=False&rdo_SelectSortBy=Shareholding&sel_ShareholdingDate_d=27&sel_ShareholdingDate_m=10&sel_ShareholdingDate_y=2014&txt_stock_code=08056&txt_stock_name=&txt_ParticipantID=&txt_Participant_name="
        CopyToClipbox StrConv(.responseBody, vbUnicode)
     End With
End Sub
Sub CopyToClipbox(strText As String) '文件 COPY 到記事簿
    With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText strText
        .PutInClipboard
    End With
End Sub

解決