ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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

[ª©¥DºÞ²z¯d¨¥]
  • GBKEE(2016/6/15 12:57): ¥iGoogle "¶Ã½X" ´M¨D¸Ñ¨M

¥»©«³Ì«á¥Ñ c_c_lai ©ó 2016-6-15 15:21 ½s¿è

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

¥¿½TÀ³¬° (¤U¹Ï) ¡G
  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 ©ó 2016-6-15 15:22 ½s¿è

¹ï¤£°_¡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)

TOP

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

TOP

¦^´_ 3# c_c_lai
¥i¬d¬d ADODB.Stream ¥Îªk ,
¤G¶i¦ì¤è¦¡¼g¤J .responseBody , ¦A«ü©w¦r²Å¶°¥H "big5" Ū¥X¨Ó
ªí¹F¤£²M¡BÃD·N¤£©ú½T¡B¨SªþÀɮ׮榡¡B¨S¦³°Q½×°ÝÃDªººA«×~~~~~~¥H¤W·R²ö¯à§U¡C

TOP

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

TOP

¦^´_ 5# c_c_lai

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

  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

TOP

¥»©«³Ì«á¥Ñ c_c_lai ©ó 2016-6-16 11:44 ½s¿è

¦^´_ 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

TOP

¦^´_ 7# c_c_lai

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

TOP

¦^´_ 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

TOP

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

TOP

        ÀR«ä¦Û¦b : §g¤l¥ß«í§Ó¡A¤p¤H«í¥ß§Ó¡C
ªð¦^¦Cªí ¤W¤@¥DÃD