本帖最後由 c_c_lai 於 2016-6-15 15:21 編輯
請問各位大大，
由網頁取得的資料，不知道要如何同步編碼成正確之中文碼回傳，
如附圖 (上圖) ：
正確應為 (下圖) ：
- Sub 上市當沖4()
- 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
- Dim TVal() As Variant, sPost As String
-
- If Select_Name = -1 Then Exit Sub
- TVal = Array("MS", "", "0049", "0099P", "019919T", "0999", "0999P", "01", "02", "03", _
- "04", "05", "06", "07", "21", "22", "08", "09", "10", _
- "11", "12", "13", "24", "25", "26", "27", "28", "29", _
- "30", "31", "14", "15", "16", "17", "18", "23", "9299", "19", "20", "CB")
-
- url = "http://www.twse.com.tw/ch/trading/exchange/TWTB4U/TWTB4U.php"
- xDate = Format(Sheets("總表").[B1], "EE/MM/DD")
- sPost = "input_date=" & Replace(xDate, "/", "%2F") & "&select2=" & TVal(Select_Name) 'urlencode
-
- Set oXmlhttp = CreateObject("msxml2.xmlhttp")
- Set oHtmldoc = CreateObject("htmlfile")
-
- With Sheets("上市")
- .Select
- .Cells.Clear
-
- With oXmlhttp
- .Open "Post", url, False
- ' .setRequestHeader "Connection", "Keep-Alive" ' 短時間內多次查詢建議可加這行
- .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
- .setRequestHeader "Content-Length", Len(sPost)
- .Send sPost
- ' 上面 Open 參數用 False (=同步)，可以不用再判斷 status
- ' Do While .Status <> 200 Or .readyState <> 4: DoEvents: Loop
- oHtmldoc.write .responseText
- ' MsgBox .responseText
- End With
-
- Set xTable = oHtmldoc.all.tags("TABLE")
- ' Stop
- For Each E In Array(8, 10) ' 8, 10 -> "TABLE"
- Set xTable = oHtmldoc.all.tags("TABLE")(E)
- ' Set xTable = oHtmldoc.all.tags("TABLE")(0)
- k = k + 1
-
- For R = 0 To xTable.Rows.Length - 1
- For c = 0 To xTable.Rows(R).Cells.Length - 1
- Sheets("上市").Cells(k, c + 1) = xTable.Rows(R).Cells(c).INNERTEXT
- Next
- k = k + 1
- Next
- If Right(sPost, 3) <> "t2=" Then Exit For
- Next
- End With
- End Sub
- Private Function Select_Name() As Integer
- With Sheets("總表").ComboBox1
- If .ListIndex = -1 Then MsgBox ("您尚未選擇「產業類別」，請於" & vbCrLf & "確認後再次點選『開啟網頁』，" & vbCrLf & "謝謝您！")
- Select_Name = .ListIndex ' Select_Name = -1,0,1,2,3,4,5,6,7,8,9,.....39
- End With
- End Function
|
發表於 2016-6-15 11:50
| 
