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

[­ì³Ð] ¶°«O¸ê®Æ(§ïª©«á)

[­ì³Ð] ¶°«O¸ê®Æ(§ïª©«á)

³Ìªñ¶°«Oºô¯¸§ïª©¡A¦]¦¹¼g¤F¦¹µ{¦¡¡A¦ý¥u¬O²Ê²¤¦a§â¸ê®Æ§ì¤U¨Ó¡A¨S¦³¦h¥[¾ã²z

­Y¦³À°§U¨ì±z¡A§Æ±æ±z¦b¤U¤è¯d­Ó¨¥Åý§Úª¾¹D³á:loveliness:

­Ó¤H¤£¤Ó³ßÅwIEªk¡A©Ò¥H¥Îªº¬OWinHttpRequest¡A³t«×§Ö«Ü¦h
  1. Sub test()

  2. Cells.Clear

  3. Dim myXML As Object
  4. Set myXML = CreateObject("WinHttp.WinHttpRequest.5.1")

  5. Dim myHTML As Object
  6. Set myHTML = CreateObject("HTMLFile")

  7. With myXML
  8.     .Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False    '¥ý§ì¨ú¤é´Á
  9.     .setRequestHeader "Content-type", "application/x-www-form-urlencoded;charset=UTF-8"
  10.     .send "REQ_OPR=qrySelScaDates"
  11.    
  12.     myText = .responseText
  13.     myText1 = Split(myText, ",")
  14.     k = 1
  15.     For Each myText2 In myText1
  16.         Cells(1, k) = Replace(myText2, Chr(34), "")
  17.         Cells(1, k) = Replace(Cells(1, k), "[", "")
  18.         Cells(1, k) = Replace(Cells(1, k), "]", "")
  19.         k = k + 1
  20.     Next
  21.    
  22.     i = 6
  23.    
  24.     For Each myDate In Range("A1:BH1").Value
  25.         
  26.         .Open "POST", "https://www.tdcc.com.tw/smWeb/QryStockAjax.do", False    '¥N¤J¤é´Á¼´¸ê®Æ
  27.         .setRequestHeader "Content-type", "application/x-www-form-urlencoded"
  28.         .send "scaDates=" & myDate & "&scaDate=" & myDate & "&SqlMethod=StockNo&StockNo=2330&StockName=&REQ_OPR=SELECT&clkStockNo=2330&clkStockName="
  29.       
  30.         myHTML.body.innerHTML = .responseText
  31.    
  32.         Set myTable = myHTML.getElementsByTagName("table")(7)
  33.         
  34.         For Each myRow In myTable.Rows
  35.             j = 1
  36.             For Each myCell In myRow.Cells
  37.                 Cells(i, j) = myCell.innerText
  38.                 j = j + 1
  39.             Next
  40.             i = i + 1
  41.         Next
  42.         i = i + 5
  43.         L = L + 1
  44.         If L > 10 Then Exit For '­n§ì´Xµ§¸ê®Æ
  45.     Next
  46.    
  47. End With
  48. Set myXML = Nothing
  49. Set myHTML = Nothing

  50. End Sub
½Æ»s¥N½X
Excel VBAºô­¶¸ê®Æ¦¬¶°±Ð¾Ç:
http://forum.twbts.com/thread-20848-1-1.html

¦^´_ 25# quickfixer


    ­q¥¿,¤£¯à¥Î51,¦³®É­Ô¬O50
­×¥¿¥Îubound
For d = 0 To UBound(firDate)

TOP

¦^´_ 24# dino123


²{¦bsend 2¦¸,­n¦h§ì¤@¦¸°ÊºAªºkey    SYNCHRONIZER_TOKEN
©Ò¥H§ïª©«á¤U¸ü®É¶¡·|¬O§ïª©«eªº2­¿
§A¨SÀɮקڤ£ª¾¹Dcell¤º¬O¤°»òªF¦è

22#  9§ï¦¨51,´N¬O1¦~
For d = 0 To 9 'ªñ¤Q©P
For d = 0 To 51

TOP

§Úªºµ{¦¡¡A¤@¦¸·|§ì¨ú¤@¦~¤U¨ÓªºTDCC ¸ê®Æ
¤£¾å±o³o¦¸§ïª©«á¡A§Úªºµ{¦¡¨ºÃä¹ïÀ³¤£¨ì¡A

Sub GoTDCC1yr()
'
' GoTDCC1yr Macro
'
Dim TWYear, CEYear As String
    For m = 1 To 51
        Dim WinHttp As Object, DOM As Object, Table As Object
        Dim url As String, Title() As String, Stockid As String, weekDate As String
        Dim i As Integer, j As Integer

        TWYear = Sheets("¤T¤jªk¤H").Cells(m, "O") '¥Á°ê¦~¤é´Á
        CEYear = Sheets("¤T¤jªk¤H").Cells(m, "P")  '¦è¤¸¦~¤é´Á
        Sheets(TWYear).Activate
StartTDCC:
        Stock = Worksheets("¤T¤jªk¤H").Range("M1").Value  'ªÑ²¼¥N½X
        weekDate = Sheets("¤T¤jªk¤H").Cells(m, "P")   '¦è¤¸¦~¤é´Á tdcc ¥Î¦è¤¸¦~¤ë¤é
        url = "https://www.tdcc.com.tw/portal/zh/smWeb/qryStock"  ' §ï³o¼Ë¬O§_¥¿½T¡H
        '  url = "https://www.tdcc.com.tw/smWeb/QryStockAjax.do"    ­ì¥»url

        Set WinHttp = CreateObject("winhttp.winhttprequest.5.1")
        Set DOM = CreateObject("htmlfile")

        With WinHttp                                    '³o¸Ì¤£ª¾¦p¦ó§ï¹ïÀ³³o¦¸ªº§ïª©
            .Open "POST", url, False
            .setrequestheader "Content-Type", "application/x-www-form-urlencoded"
            .send "scaDate=" & weekDate & "&clkStockNo=" & Stock & "&REQ_OPR=SELECT"
        
            If .Status = 200 Then
                DOM.body.innerHTML = .responsetext
            End If
        End With

        Set Table = DOM.getElementsByTagName("table")
        i = 1
        For Each tr In Table(6).Rows                                                     ' ÁÙ¬O¦^¶Ç¸ê®Æ­n§ï¡H
            j = 1
            For Each td In tr.Cells
                Sheets(TWYear).Cells(i, j) = td.innerText
                j = j + 1
            Next
            i = i + 1
        Next
   
        i = 2
        For Each tr In Table(7).Rows
            j = 1
            For Each td In tr.Cells
                Sheets(TWYear).Cells(i, j) = td.innerText
                j = j + 1
            Next
            i = i + 1
        Next
   
        Set Table = Nothing
        Set DOM = Nothing
        Set WinHttp = Nothing
              
    Next
   
End Sub
DINO

TOP

¦^´_ 22# quickfixer


    ·PÁ¦^´_¡K¦ý§Ú«á¨Ó¥Îªº§ìªk¡A¦n¹³¤£¤Ó¤@¼Ë¡A§Ú¥ÎWinHttp ¦ü¥G§Ö«Ü¦h¡C §Ú§â§Ú¥Îªºµ{¦¡¶K¦b¤U­±·sªº¤@«h¶K¤å
DINO

TOP

¥»©«³Ì«á¥Ñ quickfixer ©ó 2022-9-10 01:08 ½s¿è

¦^´_ 21# dino123

°Ñ¦Ò¸ê®Æ
    https://www.mobile01.com/topicdetail.php?f=511&t=4737630&p=125
    https://www.mobile01.com/topicdetail.php?f=511&t=4737630&p=126

  1. Sub Get_tdcc()
  2.    
  3.    
  4.     Dim Html As Object, GetXml As Object, r As Integer, url_a As String, temp() As String, ttt As Double
  5.     Dim SYNCHRONIZER_TOKEN As String, firDate, StockID As String, StockName As String
  6.     Set Html = CreateObject("htmlfile")
  7.     Set GetXml = CreateObject("msxml2.xmlhttp")
  8.    
  9.    
  10.     ttt = Timer
  11.     Application.ScreenUpdating = False
  12.     On Error GoTo redownload

  13.    
  14.     'StockID = "2002"
  15.     StockID = "2330"
  16.    
  17. retry1:

  18.     With GetXml
  19.         .Open "GET", "https://www.tdcc.com.tw/portal/zh/smWeb/qryStock", False
  20.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  21.         .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:102.0) Gecko/20100101 Firefox/102.0"
  22.         .send
  23.         
  24.         Html.body.innerhtml = .responsetext
  25.         firDate = Split(Trim(Html.getElementById("scaDate").innertext), " ")
  26.         
  27.         If IsEmpty(firDate) = True Then
  28.            Debug.Print "get day error"
  29.            Delaytick (0.5)
  30.            r = r + 1
  31.            Debug.Print r
  32.            If r > 3 Then
  33.                MsgBox "½u¤W¤é´ÁµLªk§ó·s¡A½Ðµy«á­«¸Õ", vbOKOnly, "Error"
  34.                Exit Sub
  35.            End If
  36.            If Err.Number <> 0 Then
  37.                Debug.Print Err.Description
  38.            End If
  39.            On Error GoTo -1
  40.            Err.Clear
  41.            GoTo retry1
  42.         End If
  43.         
  44.     End With
  45.    
  46.    
  47.    
  48.    
  49. retry2:
  50.    
  51.     For d = 0 To 9 'ªñ¤Q©P
  52.    
  53.         With GetXml
  54.             .Open "GET", "https://www.tdcc.com.tw/portal/zh/smWeb/qryStock", False
  55.             .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  56.             .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:102.0) Gecko/20100101 Firefox/102.0"
  57.             .send
  58.         
  59.             Html.body.innerhtml = .responsetext
  60.             SYNCHRONIZER_TOKEN = Html.getElementById("SYNCHRONIZER_TOKEN").Value
  61.    
  62.         
  63.         End With
  64.            
  65.          
  66.         url_a = "SYNCHRONIZER_TOKEN=" & SYNCHRONIZER_TOKEN & "&SYNCHRONIZER_URI=%2Fportal%2Fzh%2FsmWeb%2FqryStock&method=submit&firDate=" & firDate(d) & "&scaDate=" & firDate(d) & "&sqlMethod=StockNo&stockNo=" & StockID & "&stockName="
  67.         
  68.         With GetXml
  69.             .Open "POST", "https://www.tdcc.com.tw/portal/zh/smWeb/qryStock", False
  70.             .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
  71.             .setRequestHeader "Referer", "https://www.tdcc.com.tw/portal/zh/smWeb/qryStock"
  72.             .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:102.0) Gecko/20100101 Firefox/102.0"
  73.             .send (url_a)
  74.             
  75.             Html.body.innerhtml = .responsetext
  76.         
  77.             If d = 0 Then
  78.                 StockName = Replace(Split(Split(.responsetext, "ÃÒ¨é¥N¸¹¡G")(1), "</p>")(0), Chr(10), "")
  79.                 StockName = "ÃÒ¨é¥N¸¹¡G" & Replace(Replace(StockName, " ", ""), "<br>", " ")
  80.                 Sheets("¤u§@ªí1").Cells.Clear
  81.                 Sheets("¤u§@ªí1").Columns.ColumnWidth = 16
  82.                 Sheets("¤u§@ªí1").Range("a1") = StockName
  83.             End If
  84.                
  85.             Set Table = Html.all.tags("table")(1).Rows
  86.             
  87.             If Table(1).Cells(0).innertext = "¬dµL¦¹¸ê®Æ" Then
  88.                 Delaytick (0.3)
  89.                 r = r + 1
  90.                 If r > 5 Then
  91.                     MsgBox StockID & vbNewLine & firDate & "¡A¦¹¤é´ÁµL¸ê®Æ©Î³s½u²§±`¡A½Ðµy«á¦A¸Õ", vbOKOnly, "Error"
  92.                     Set Table = Nothing
  93.                     Set Html = Nothing
  94.                     Set GetXml = Nothing
  95.                     Application.ScreenUpdating = True
  96.                     Exit Sub
  97.                 End If
  98.                 GoTo retry2
  99.             End If
  100.             
  101.                
  102.             ReDim temp(1 To Table.Length - 1, Table(2).Cells.Length - 1)
  103.                
  104.             With Sheets("¤u§@ªí1")
  105.                
  106.             
  107.                 For i = 1 To Table.Length - 1
  108.                     
  109.                     For j = 0 To Table(i).Cells.Length - 1
  110.                         temp(i, j) = Table(i).Cells(j).innertext
  111.                     Next j
  112.                 Next i
  113.             
  114.                 .Range("a2").Offset(, d * 5) = firDate(d)
  115.                 .Range("a3:e3").Offset(, d * 5) = Array("§Ç", "«ùªÑ", "¤H¼Æ", "ªÑ¼Æ", "¤ñ¨Ò%")
  116.                 .Range(.Cells(4, 1), .Cells(i + 2, 5)).Offset(, d * 5) = temp()
  117.             
  118.             End With

  119.         End With
  120.    
  121.     Next d
  122.    
  123.     Set Table = Nothing
  124.     Set Html = Nothing
  125.     Set GetXml = Nothing
  126.     Application.ScreenUpdating = True
  127.    
  128.     Debug.Print Timer - ttt
  129.     Exit Sub
  130.    
  131. redownload:
  132.     r = r + 1
  133.     Debug.Print "http 404"
  134.     Delaytick (1.3)
  135.     If r > 3 Then
  136.        MsgBox "³s½u²§±`¡A½Ðµy«á¦A¸Õ", vbOKOnly, "Error"
  137.       
  138.        'Stop 'debug
  139.       
  140.        Set Table = Nothing
  141.        Set Html = Nothing
  142.        Set GetXml = Nothing
  143.        Application.ScreenUpdating = True
  144.        Exit Sub
  145.    
  146.     End If
  147.    
  148.     If Err.Number <> 0 Then
  149.         Debug.Print Err.Description
  150.     End If
  151.    
  152.     On Error GoTo -1
  153.     Err.Clear
  154.    
  155.     GoTo retry2


  156. End Sub

  157. Sub Delaytick(setdelay As Single)
  158.    
  159.     Dim StartTime As Double, NowTime As Double
  160.     StartTime = Timer * 100
  161.     setdelay = setdelay * 100
  162.     Do
  163.       NowTime = Timer * 100
  164.       DoEvents
  165.     Loop Until NowTime - StartTime > setdelay
  166.    
  167. End Sub
½Æ»s¥N½X

TOP

ÁÂÁª©¥D¶}ª©¡Aµ{¦¡§Ú¦³®³¨Ó§ï«á¨Ï¥Î
¦ý¤W¬P´Á(11109)¶°«Oªººô¯¸§ïª©¤F
§Ú¦Û¤v§ï¤£¥X¨Ó§ì¨ú¡A¯à§_§ï¤@¤U©O
DINO

TOP

¦^´_ 2# joey0415

¤p§Ì¤£¤~ ·Q½Ð°Ý §Ú±NÀɮקì¤U¨Ó¤F
¦ý¤p§Ì¤£ª¾¦p¦ó ·J¾ã
¤p§Ì·Q·J¾ã
1000±i¥H¤Wªº¤ñ¨Ò
200±i¥H¤Uªº¤ñ¨Ò

·Q½Ð¤j¤jÀ°¦£  ±Ð±Ð¤p§Ì
«D±`·PÁ±zªºÀ°¦£
ÁÂÁÂ
¾Ç²ß ¾Ç²ß ¤@ª½¾Ç²ß

TOP

½Ð°Ý­Y»Ý­n§ó§ï¬°¶°«O¤j©ó400±i¥H¤WÁͶդñ¸û¸Ó¦p¦óÅܧó

TOP

¦^´_ 11# iamaraymond
ÁÂÁÂiamaraymond¤j
¦~ÄÖ¤£¤p,¦ý§Ú«Ü·Q¾Ç

TOP

        ÀR«ä¦Û¦b : ¶¢¤HµL¼Ö½ì¡A¦£¤HµL¬O«D¡C
ªð¦^¦Cªí ¤W¤@¥DÃD