dino123

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

quickfixer

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

¤U¸ü (44.73 KB)

2022-9-10 01:04

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.    
    
15.     'StockID = "2002"
    
16.     StockID = "2330"
    
17.    
    
18. retry1:
    
19. 
    
20.     With GetXml
    
21.         .Open "GET", "https://www.tdcc.com.tw/portal/zh/smWeb/qryStock", False
    
22.         .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
23.         .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:102.0) Gecko/20100101 Firefox/102.0"
    
24.         .send
    
25.         
    
26.         Html.body.innerhtml = .responsetext
    
27.         firDate = Split(Trim(Html.getElementById("scaDate").innertext), " ")
    
28.         
    
29.         If IsEmpty(firDate) = True Then
    
30.            Debug.Print "get day error"
    
31.            Delaytick (0.5)
    
32.            r = r + 1
    
33.            Debug.Print r
    
34.            If r > 3 Then
    
35.                MsgBox "½u¤W¤é´ÁµLªk§ó·s¡A½Ðµy«á­«¸Õ", vbOKOnly, "Error"
    
36.                Exit Sub
    
37.            End If
    
38.            If Err.Number <> 0 Then
    
39.                Debug.Print Err.Description
    
40.            End If
    
41.            On Error GoTo -1
    
42.            Err.Clear
    
43.            GoTo retry1
    
44.         End If
    
45.         
    
46.     End With
    
47.    
    
48.    
    
49.    
    
50.    
    
51. retry2:
    
52.    
    
53.     For d = 0 To 9 'ªñ¤Q©P
    
54.    
    
55.         With GetXml
    
56.             .Open "GET", "https://www.tdcc.com.tw/portal/zh/smWeb/qryStock", False
    
57.             .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
58.             .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:102.0) Gecko/20100101 Firefox/102.0"
    
59.             .send
    
60.         
    
61.             Html.body.innerhtml = .responsetext
    
62.             SYNCHRONIZER_TOKEN = Html.getElementById("SYNCHRONIZER_TOKEN").Value
    
63.    
    
64.         
    
65.         End With
    
66.            
    
67.          
    
68.         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="
    
69.         
    
70.         With GetXml
    
71.             .Open "POST", "https://www.tdcc.com.tw/portal/zh/smWeb/qryStock", False
    
72.             .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    
73.             .setRequestHeader "Referer", "https://www.tdcc.com.tw/portal/zh/smWeb/qryStock"
    
74.             .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:102.0) Gecko/20100101 Firefox/102.0"
    
75.             .send (url_a)
    
76.             
    
77.             Html.body.innerhtml = .responsetext
    
78.         
    
79.             If d = 0 Then
    
80.                 StockName = Replace(Split(Split(.responsetext, "ÃÒ¨é¥N¸¹¡G")(1), "</p>")(0), Chr(10), "")
    
81.                 StockName = "ÃÒ¨é¥N¸¹¡G" & Replace(Replace(StockName, " ", ""), "<br>", " ")
    
82.                 Sheets("¤u§@ªí1").Cells.Clear
    
83.                 Sheets("¤u§@ªí1").Columns.ColumnWidth = 16
    
84.                 Sheets("¤u§@ªí1").Range("a1") = StockName
    
85.             End If
    
86.                
    
87.             Set Table = Html.all.tags("table")(1).Rows
    
88.             
    
89.             If Table(1).Cells(0).innertext = "¬dµL¦¹¸ê®Æ" Then
    
90.                 Delaytick (0.3)
    
91.                 r = r + 1
    
92.                 If r > 5 Then
    
93.                     MsgBox StockID & vbNewLine & firDate & "¡A¦¹¤é´ÁµL¸ê®Æ©Î³s½u²§±`¡A½Ðµy«á¦A¸Õ", vbOKOnly, "Error"
    
94.                     Set Table = Nothing
    
95.                     Set Html = Nothing
    
96.                     Set GetXml = Nothing
    
97.                     Application.ScreenUpdating = True
    
98.                     Exit Sub
    
99.                 End If
    
100.                 GoTo retry2
     
101.             End If
     
102.             
     
103.                
     
104.             ReDim temp(1 To Table.Length - 1, Table(2).Cells.Length - 1)
     
105.                
     
106.             With Sheets("¤u§@ªí1")
     
107.                
     
108.             
     
109.                 For i = 1 To Table.Length - 1
     
110.                     
     
111.                     For j = 0 To Table(i).Cells.Length - 1
     
112.                         temp(i, j) = Table(i).Cells(j).innertext
     
113.                     Next j
     
114.                 Next i
     
115.             
     
116.                 .Range("a2").Offset(, d * 5) = firDate(d)
     
117.                 .Range("a3:e3").Offset(, d * 5) = Array("§Ç", "«ùªÑ", "¤H¼Æ", "ªÑ¼Æ", "¤ñ¨Ò%")
     
118.                 .Range(.Cells(4, 1), .Cells(i + 2, 5)).Offset(, d * 5) = temp()
     
119.             
     
120.             End With
     
121. 
     
122.         End With
     
123.    
     
124.     Next d
     
125.    
     
126.     Set Table = Nothing
     
127.     Set Html = Nothing
     
128.     Set GetXml = Nothing
     
129.     Application.ScreenUpdating = True
     
130.    
     
131.     Debug.Print Timer - ttt
     
132.     Exit Sub
     
133.    
     
134. redownload:
     
135.     r = r + 1
     
136.     Debug.Print "http 404"
     
137.     Delaytick (1.3)
     
138.     If r > 3 Then
     
139.        MsgBox "³s½u²§±`¡A½Ðµy«á¦A¸Õ", vbOKOnly, "Error"
     
140.       
     
141.        'Stop 'debug
     
142.       
     
143.        Set Table = Nothing
     
144.        Set Html = Nothing
     
145.        Set GetXml = Nothing
     
146.        Application.ScreenUpdating = True
     
147.        Exit Sub
     
148.    
     
149.     End If
     
150.    
     
151.     If Err.Number <> 0 Then
     
152.         Debug.Print Err.Description
     
153.     End If
     
154.    
     
155.     On Error GoTo -1
     
156.     Err.Clear
     
157.    
     
158.     GoTo retry2
     
159. 
     
160. 
     
161. End Sub
     
162. 
     
163. Sub Delaytick(setdelay As Single)
     
164.    
     
165.     Dim StartTime As Double, NowTime As Double
     
166.     StartTime = Timer * 100
     
167.     setdelay = setdelay * 100
     
168.     Do
     
169.       NowTime = Timer * 100
     
170.       DoEvents
     
171.     Loop Until NowTime - StartTime > setdelay
     
172.    
     
173. End Sub

½Æ»s¥N½X

dino123

¦^´_ 22# quickfixer


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

dino123

§Úªºµ{¦¡¡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

quickfixer

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

quickfixer

¦^´_ 25# quickfixer


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