joey0415

回復 5# c_c_lai

賴大試試，我只會拿以前的來改

下載 (47.3 KB)

2016-6-16 08:59

1. Sub 證交所()
   
2.    
   
3.   Dim strText As String
   
4.   Dim i As Integer
   
5.   Dim j As Integer
   
6.   Dim nRow As Integer
   
7.   Dim xRow As Integer
   
8.   Dim nCol As Byte
   
9.   Dim TR As Object
   
10.   Dim TD As Object
    
11.   Dim Arr()
    
12.   Cells.Clear
    
13.   
    
14.   With CreateObject("winhttp.winhttprequest.5.1")
    
15.     .Open "POST", "http://www.twse.com.tw/ch/trading/exchange/TWTB4U/TWTB4U.php", False
    
16.     .setrequestheader "Referer", "http://www.twse.com.tw/ch/trading/exchange/TWTB4U/TWTB4U.php"
    
17.     .setrequestheader "Content-Type", "application/x-www-form-urlencoded"
    
18.     .Send "input_date=105%2F06%2F15&select2=21&login_btn=+%ACd%B8%DF+"
    
19.     strText = BinToStr(.ResponseBody, "BIG5") '要注意網頁編碼
    
20.   End With
    
21.   
    
22.   With CreateObject("htmlfile")
    
23.     .Write strText
    
24.             Set hTable = .all.tags("table")(8)
    
25.             tt = hTable.Rows.Length
    
26.                 With ActiveSheet
    
27.                     For i = 0 To hTable.Rows.Length - 1
    
28.                         For j = 0 To hTable.Rows(i).Cells.Length - 1
    
29.                                 .Cells(i + 1, j + 1) = hTable.Rows(i).Cells(j).innertext
    
30.                         Next
    
31.                     Next
    
32.                 End With
    
33.    
    
34.   End With
    
35. End Sub
    
36. Function BinToStr(arrBin, strChrs)
    
37.     With CreateObject("ADODB.Stream")
    
38.         .Type = 2
    
39.         .Open
    
40.         .Writetext arrBin
    
41.         .Position = 0
    
42.         .Charset = strChrs
    
43.         .Position = 2
    
44.         BinToStr = .ReadText
    
45.         .Close
    
46.     End With
    
47. End Function

複製代碼

joey0415

回復 7# c_c_lai

賴大以前幫助小弟很多，小弟只把以前抄的東西修改一下讓賴大試試