- 帖子
- 8
- 主題
- 2
- 精華
- 0
- 積分
- 10
- 點名
- 0
- 作業系統
- xp
- 軟體版本
- xp
- 閱讀權限
- 10
- 註冊時間
- 2015-8-27
- 最後登錄
- 2018-9-12
|
回復 6# joey0415
請問這個用你的 BinToStr( ) 為何就無法轉成功呢
Sub Test()
Dim xTable As Object, k As Integer, C As Integer, R As Integer ' , sn As Integer
Dim url As String, cts As Integer, E As Variant, xDate As String ' , rc As Integer
Dim oXmlhttp As Object, oHtmldoc As Object, select2 As String ' , tm
xDate = "105/06/13"
url = "http://www.twse.com.tw/ch/trading/exchange/TWTB4U/TWTB4U.php"
sPost = "input_date=" & Replace(xDate, "/", "%2F") & "&select2=" & "01" 'urlencode
Set oXmlhttp = CreateObject("msxml2.xmlhttp")
Set oHtmldoc = CreateObject("htmlfile")
With oXmlhttp
.Open "Post", url, False
'.setRequestHeader "Connection", "Keep-Alive" '短時間內多次查詢建議可加這行
.setRequestHeader "Content-Type", "text/html"
.setRequestHeader "Content-Length", Len(sPost)
.Send sPost
oHtmldoc.Write .responseText
End With
Set xTable = oHtmldoc.ALL.tags("TABLE")
' Stop
' 看看區域變數視窗 xTable 的內容
Set xTable = oHtmldoc.ALL.tags("TABLE")(0)
' Stop
' 再次看看區域變數視窗 xTable 的內容
'MsgBox xTable.INNERTEXT
'Debug.Print xTable.INNERTEXT
gg = BinToStr(xTable.INNERTEXT, "BIG5")
Debug.Print gg
End Sub
Function BinToStr(arrBin, strChrs)
Set objstream = CreateObject("ADODB.Stream")
With objstream
.Type = 2
.Open
.WriteText arrBin
.Position = 0
.Charset = strChrs
.Position = 2
BinToStr = .ReadText
.Close
End With
End Function |
|