- 帖子
- 155
- 主題
- 1
- 精華
- 0
- 積分
- 200
- 點名
- 4
- 作業系統
- windwos 7
- 軟體版本
- 64bit
- 閱讀權限
- 20
- 註冊時間
- 2017-5-29
- 最後登錄
- 2026-10-25
|
本帖最後由 quickfixer 於 2022-2-12 23:14 編輯
回復 27# quickfixer
我參考你給的01網址686f,加入重新下載功能,可全部跑完- Private Sub GetDividend(ByVal ss As String) '取股利網頁 '2022/2/22 換這段程式碼 在 https://www.mobile01.com/topicdetail.php?f=511&t=4737630&p=3 的21樓
- Dim URL, HTMLsourcecode, GetXml, Table
- Dim i As Integer, j As Integer, r As Integer
- Set HTMLsourcecode = CreateObject("htmlfile")
- Set GetXml = CreateObject("msxml2.xmlhttp")
- URL = "http://pscnetinvest.moneydj.com.tw/z/zc/zch/zch_" & ss & ".djhtm"
- r = 0
- retry:
- On Error Resume Next
- With GetXml
- .Open "GET", URL, False
- .setRequestHeader "Cache-Control", "no-cache"
- .setRequestHeader "Pragma", "no-cache"
- .setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
- .send
- HTMLsourcecode.body.innerhtml = .responsetext
- Set Table = HTMLsourcecode.all.tags("table")(2).Rows
- If Err.Number <> 0 Then
- If r > 3 Then
- '超過3次,改抓下一筆,避免無限loop
- Exit Sub
- End If
- Debug.Print Err.Description
- r = r + 1
- On Error GoTo -1
- Err.Clear
- '等0.5秒
- Delaytick (0.5)
- GoTo retry
- End If
-
- For i = 0 To Table.Length - 1
- For j = 0 To Table(i).Cells.Length - 1
- 工作表2.Cells(i + 1, j + 1) = Table(i).Cells(j).innertext
- Next j
- Next i
- End With
- Set HTMLsourcecode = Nothing
- Set GetXml = Nothing
- 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
可能要改一下,有人excel日期是用-不是/
用mid可能會比較好一些 |
|
發表於 2022-2-12 20:52
| 
