[µo°Ý] ¥Ñºô­¶¨ú±oªº¸ê®Æ¡A¤£ª¾¹D­n¦p¦ó¦P¨B½s½X¦¨¥¿½T¤§¤¤¤å½X¦^¶Ç

c_c_lai

½Ð°Ý¦U¦ì¤j¤j¡A
¥Ñºô­¶¨ú±oªº¸ê®Æ¡A¤£ª¾¹D­n¦p¦ó¦P¨B½s½X¦¨¥¿½T¤§¤¤¤å½X¦^¶Ç¡A
¦pªþ¹Ï  (¤W¹Ï) ¡G

¤U¸ü (28.82 KB)

2016-6-15 11:48

¥¿½TÀ³¬° (¤U¹Ï) ¡G

¤U¸ü (35.06 KB)

2016-6-15 11:49

1. Sub ¤W¥«·í¨R4()
   
2.     Dim xTable As Object, k As Integer, c As Integer, R As Integer        '  , sn As Integer
   
3.     Dim url As String, cts As Integer, E As Variant, xDate As String      '  , rc As Integer
   
4.     Dim oXmlhttp As Object, oHtmldoc As Object, select2 As String         '  , tm
   
5.     Dim TVal() As Variant, sPost As String
   
6.    
   
7.     If Select_Name = -1 Then Exit Sub
   
8.     TVal = Array("MS", "", "0049", "0099P", "019919T", "0999", "0999P", "01", "02", "03", _
   
9.                 "04", "05", "06", "07", "21", "22", "08", "09", "10", _
   
10.                 "11", "12", "13", "24", "25", "26", "27", "28", "29", _
    
11.                 "30", "31", "14", "15", "16", "17", "18", "23", "9299", "19", "20", "CB")
    
12.    
    
13.     url = "http://www.twse.com.tw/ch/trading/exchange/TWTB4U/TWTB4U.php"
    
14.     xDate = Format(Sheets("Á`ªí").[B1], "EE/MM/DD")
    
15.     sPost = "input_date=" & Replace(xDate, "/", "%2F") & "&select2=" & TVal(Select_Name)  'urlencode
    
16.    
    
17.     Set oXmlhttp = CreateObject("msxml2.xmlhttp")
    
18.     Set oHtmldoc = CreateObject("htmlfile")
    
19.    
    
20.     With Sheets("¤W¥«")
    
21.         .Select
    
22.         .Cells.Clear
    
23.         
    
24.         With oXmlhttp
    
25.             .Open "Post", url, False
    
26.             '  .setRequestHeader "Connection", "Keep-Alive"   '  µu®É¶¡¤º¦h¦¸¬d¸ß«Øij¥i¥[³o¦æ
    
27.             .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
28.             .setRequestHeader "Content-Length", Len(sPost)
    
29.             .Send sPost
    
30.             '  ¤W­± Open °Ñ¼Æ¥Î False (=¦P¨B)¡A¥i¥H¤£¥Î¦A§PÂ_ status
    
31.             '  Do While .Status <> 200 Or .readyState <> 4: DoEvents: Loop
    
32.             oHtmldoc.write .responseText
    
33.             '  MsgBox .responseText
    
34.         End With
    
35.         
    
36.         Set xTable = oHtmldoc.all.tags("TABLE")
    
37.         '  Stop
    
38.         For Each E In Array(8, 10)       '  8, 10  ->  "TABLE"
    
39.             Set xTable = oHtmldoc.all.tags("TABLE")(E)
    
40.             '  Set xTable = oHtmldoc.all.tags("TABLE")(0)
    
41.             k = k + 1
    
42.             
    
43.             For R = 0 To xTable.Rows.Length - 1
    
44.                 For c = 0 To xTable.Rows(R).Cells.Length - 1
    
45.                     Sheets("¤W¥«").Cells(k, c + 1) = xTable.Rows(R).Cells(c).INNERTEXT
    
46.                 Next
    
47.                 k = k + 1
    
48.             Next
    
49.             If Right(sPost, 3) <> "t2=" Then Exit For
    
50.         Next
    
51.     End With
    
52. End Sub

½Æ»s¥N½X

1. Private Function Select_Name() As Integer
   
2.     With Sheets("Á`ªí").ComboBox1
   
3.         If .ListIndex = -1 Then MsgBox ("±z©|¥¼¿ï¾Ü¡u²£·~Ãþ§O¡v¡A½Ð©ó" & vbCrLf & "½T»{«á¦A¦¸ÂI¿ï¡y¶}±Òºô­¶¡z¡A" & vbCrLf & "ÁÂÁ±z¡I")
   
4.         Select_Name = .ListIndex    '  Select_Name = -1,0,1,2,3,4,5,6,7,8,9,.....39
   
5.     End With
   
6. End Function

½Æ»s¥N½X

ÁÂÁ¦U¦ì¤j¤j¡I

c_c_lai

¹ï¤£°_¡A¤j·§§Ú¨S´y­z²M·¡¡C¼Ó¤Wªº¹Ï¤ù§¡¬O³z¹L¦P¼Ëªººô§} ¡A
¦Ó¥H¤£¦P³sµ²³B²z¤è¦¡°õ¦æ¥X¨Óªºµ²ªG¡C

1.     With ActiveSheet.QueryTables.Add(Connection:= _
   
2.                   "URL;http://www.twse.com.tw/ch/trading/exchange/TWTB4U/TWTB4U.php", Destination:=Range( _
   
3.                   "$A$1"))

½Æ»s¥N½X

³sµ²³B²z¤è¦¡ (¤U¹Ï) «h¬O¥¿±`¡F¦ý¬O¥H

1.         With oXmlhttp
   
2.             .Open "Post", url, False
   
3.             '  .setRequestHeader "Connection", "Keep-Alive"   '  µu®É¶¡¤º¦h¦¸¬d¸ß«Øij¥i¥[³o¦æ
   
4.             .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
   
5.             .setRequestHeader "Content-Length", Len(sPost)
   
6.             .Send sPost
   
7.             '  ¤W­± Open °Ñ¼Æ¥Î False (=¦P¨B)¡A¥i¥H¤£¥Î¦A§PÂ_ status
   
8.             '  Do While .Status <> 200 Or .readyState <> 4: DoEvents: Loop
   
9.             oHtmldoc.write .responseText
   
10.             '  MsgBox .responseText
    
11.         End With

½Æ»s¥N½X

(¤W¹Ï) «o¬O¶Ã½X¡C
ªþ¤WÀɮ׳ö¨Ñ¦U¦ì¤j¤j´ú¸Õ§Yª¾¡AÁÂÁÂÅo¡I
test.rar (40.26 KB)

¤U¸ü¦¸¼Æ: 8

2016-6-15 15:16

c_c_lai

¥[¤J¥i¥¿±`·|¤§µ{¦¡¼Ò²Õ¡A¨Ñ§@¤ñ¹ï¡G
test2.rar (24.21 KB)

¤U¸ü¦¸¼Æ: 6

2016-6-15 17:01

¤U¸ü (36.48 KB)

2016-6-15 17:01

stillfish00

¦^´_ 3# c_c_lai
¥i¬d¬d ADODB.Stream ¥Îªk ,
¤G¶i¦ì¤è¦¡¼g¤J .responseBody , ¦A«ü©w¦r²Å¶°¥H "big5" Ū¥X¨Ó

c_c_lai

¦^´_ 4# stillfish00
¤£¦n·N«ä¡A¸Õ¤F¤@·|ÁÙ¬O¨S¦³´x´¤¨ì
ADODB.Stream ¥Îªk¤ß±o , ¯à§_´N¥H§Úªº
test2.rar ¬°ÃD¸Ñ´b©O¡H
ÁÂÁ§AÅo¡I

joey0415

¦^´_ 5# c_c_lai

¿à¤j¸Õ¸Õ¡A§Ú¥u·|®³¥H«eªº¨Ó§ï

¤U¸ü (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") '­nª`·Nºô­¶½s½X
    
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

½Æ»s¥N½X

c_c_lai

¦^´_ 6# joey0415
¦^´_ 4# stillfish00
«D±`·PÁ¨â¦ì¤j¤jªº¤£§[«ü¾É¡A²×§i§¹¦¨¤F¡C
¯u¬OÁ{ªù¤@¬¡A¤£ÂI¤£¿ô¡Cjoey0415 ¤j¤j´£¨Ñªº½d¨Ò
¥H¤Î¼W¥[¤F Function BinToStr(arrBin, strChrs) ªº¨ç¦¡
¥¦§êºt¤F¤@­Ó«D±`­«­nªº¸}¦â¡A¨ü±Ð¤F¡I

¤U¸ü (104.68 KB)

2016-6-16 11:25

joey0415

¦^´_ 7# c_c_lai

¿à¤j¥H«eÀ°§U¤p§Ì«Ü¦h¡A¤p§Ì¥u§â¥H«e§ÛªºªF¦è­×§ï¤@¤UÅý¿à¤j¸Õ¸Õ

yoyobuy

¦^´_ 6# joey0415

½Ð°Ý³o­Ó¥Î§Aªº BinToStr( ) ¬°¦ó´NµLªkÂন¥\©O

    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"   'µu®É¶¡¤º¦h¦¸¬d¸ß«Øij¥i¥[³o¦æ
            .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 ªº¤º®e
        Set xTable = oHtmldoc.ALL.tags("TABLE")(0)
        ' Stop
        '  ¦A¦¸¬Ý¬Ý°Ï°ìÅܼƵøµ¡ xTable ªº¤º®e
        
        '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

c_c_lai

¦^´_ 9# yoyobuy
½Ð¥J²Ó¬Ý¤@¤U #7 ¹Ï¤ù¸Ìªº¤Uµù¡A«K·|©úÁA¤F¡C