- ©«¤l
- 154
- ¥DÃD
- 1
- ºëµØ
- 0
- ¿n¤À
- 200
- ÂI¦W
- 28
- §@·~¨t²Î
- windwos 7
- ³nÅ骩¥»
- 64bit
- ¾\ŪÅv
- 20
- µù¥U®É¶¡
- 2017-5-29
- ³Ì«áµn¿ý
- 2024-10-22
|
¥»©«³Ì«á¥Ñ 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
- Sub Get_tdcc()
-
-
- Dim Html As Object, GetXml As Object, r As Integer, url_a As String, temp() As String, ttt As Double
- Dim SYNCHRONIZER_TOKEN As String, firDate, StockID As String, StockName As String
- Set Html = CreateObject("htmlfile")
- Set GetXml = CreateObject("msxml2.xmlhttp")
-
-
- ttt = Timer
- Application.ScreenUpdating = False
- On Error GoTo redownload
-
- 'StockID = "2002"
- StockID = "2330"
-
- retry1:
- With GetXml
- .Open "GET", "https://www.tdcc.com.tw/portal/zh/smWeb/qryStock", False
- .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
- .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:102.0) Gecko/20100101 Firefox/102.0"
- .send
-
- Html.body.innerhtml = .responsetext
- firDate = Split(Trim(Html.getElementById("scaDate").innertext), " ")
-
- If IsEmpty(firDate) = True Then
- Debug.Print "get day error"
- Delaytick (0.5)
- r = r + 1
- Debug.Print r
- If r > 3 Then
- MsgBox "½u¤W¤é´ÁµLªk§ó·s¡A½Ðµy«á«¸Õ", vbOKOnly, "Error"
- Exit Sub
- End If
- If Err.Number <> 0 Then
- Debug.Print Err.Description
- End If
- On Error GoTo -1
- Err.Clear
- GoTo retry1
- End If
-
- End With
-
-
-
-
- retry2:
-
- For d = 0 To 9 'ªñ¤Q©P
-
- With GetXml
- .Open "GET", "https://www.tdcc.com.tw/portal/zh/smWeb/qryStock", False
- .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
- .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:102.0) Gecko/20100101 Firefox/102.0"
- .send
-
- Html.body.innerhtml = .responsetext
- SYNCHRONIZER_TOKEN = Html.getElementById("SYNCHRONIZER_TOKEN").Value
-
-
- End With
-
-
- 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="
-
- With GetXml
- .Open "POST", "https://www.tdcc.com.tw/portal/zh/smWeb/qryStock", False
- .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
- .setRequestHeader "Referer", "https://www.tdcc.com.tw/portal/zh/smWeb/qryStock"
- .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:102.0) Gecko/20100101 Firefox/102.0"
- .send (url_a)
-
- Html.body.innerhtml = .responsetext
-
- If d = 0 Then
- StockName = Replace(Split(Split(.responsetext, "ÃÒ¨é¥N¸¹¡G")(1), "</p>")(0), Chr(10), "")
- StockName = "ÃÒ¨é¥N¸¹¡G" & Replace(Replace(StockName, " ", ""), "<br>", " ")
- Sheets("¤u§@ªí1").Cells.Clear
- Sheets("¤u§@ªí1").Columns.ColumnWidth = 16
- Sheets("¤u§@ªí1").Range("a1") = StockName
- End If
-
- Set Table = Html.all.tags("table")(1).Rows
-
- If Table(1).Cells(0).innertext = "¬dµL¦¹¸ê®Æ" Then
- Delaytick (0.3)
- r = r + 1
- If r > 5 Then
- MsgBox StockID & vbNewLine & firDate & "¡A¦¹¤é´ÁµL¸ê®Æ©Î³s½u²§±`¡A½Ðµy«á¦A¸Õ", vbOKOnly, "Error"
- Set Table = Nothing
- Set Html = Nothing
- Set GetXml = Nothing
- Application.ScreenUpdating = True
- Exit Sub
- End If
- GoTo retry2
- End If
-
-
- ReDim temp(1 To Table.Length - 1, Table(2).Cells.Length - 1)
-
- With Sheets("¤u§@ªí1")
-
-
- For i = 1 To Table.Length - 1
-
- For j = 0 To Table(i).Cells.Length - 1
- temp(i, j) = Table(i).Cells(j).innertext
- Next j
- Next i
-
- .Range("a2").Offset(, d * 5) = firDate(d)
- .Range("a3:e3").Offset(, d * 5) = Array("§Ç", "«ùªÑ", "¤H¼Æ", "ªÑ¼Æ", "¤ñ¨Ò%")
- .Range(.Cells(4, 1), .Cells(i + 2, 5)).Offset(, d * 5) = temp()
-
- End With
- End With
-
- Next d
-
- Set Table = Nothing
- Set Html = Nothing
- Set GetXml = Nothing
- Application.ScreenUpdating = True
-
- Debug.Print Timer - ttt
- Exit Sub
-
- redownload:
- r = r + 1
- Debug.Print "http 404"
- Delaytick (1.3)
- If r > 3 Then
- MsgBox "³s½u²§±`¡A½Ðµy«á¦A¸Õ", vbOKOnly, "Error"
-
- 'Stop 'debug
-
- Set Table = Nothing
- Set Html = Nothing
- Set GetXml = Nothing
- Application.ScreenUpdating = True
- Exit Sub
-
- End If
-
- If Err.Number <> 0 Then
- Debug.Print Err.Description
- End If
-
- On Error GoTo -1
- Err.Clear
-
- GoTo retry2
- End Sub
- Sub Delaytick(setdelay As Single)
-
- Dim StartTime As Double, NowTime As Double
- StartTime = Timer * 100
- setdelay = setdelay * 100
- Do
- NowTime = Timer * 100
- DoEvents
- Loop Until NowTime - StartTime > setdelay
-
- End Sub
½Æ»s¥N½X |
|