Excel VBA 自動下載期交所三大法人選擇權資料

Excel VBA 網路資料蒐集 完整教學:

https://raymondchiendtrt.blogspot.com/2018/08/vba_22.html

資料來源網址

http://www.taifex.com.tw/chinese/3/7_12_3.asp

此程式可讓使用者輸入欲查詢的天數
例如想要收集近20天的資料
就在inputbox輸入20
如果想固定收集特定天數的資料
也可在程式碼的inputbox改成你想要的天數

Sub test()

Cells.Clear

Dim myXML As Object

Set myXML = CreateObject("WinHttp.WinHttpRequest.5.1")

Dim myHTML As Object

Set myHTML = CreateObject("HTMLFile")

Dim clipboard As Object

Set clipboard = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

myCount = 0

myDate = Date

myNumber = InputBox("輸入查詢天數")

With myXML

Do

    .Open "POST", "http://www.taifex.com.tw/chinese/3/7_12_3.asp", False

    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

    .send "goday=&DATA_DATE_Y=2018&DATA_DATE_M=06&DATA_DATE_D=05&syear=" & Format(Year(myDate), "0000") & "&smonth=" & Format(Month(myDate), "00") & "&sday=" & Format(Day(myDate), "00") & "&datestart=2018%2F06%2F05&COMMODITY_ID="

    myHTML.body.innerHTML = convertraw(.responseBody)

    Set myTable = myHTML.getElementsByTagName("table")(2)

    

    If InStr(1, myTable.innerText, "查無資料") <> 0 Then GoTo myNext

    If checkDate = Format(Left(Split(myTable.innerText, "日期")(1), 10), "yyyy/mm/dd") Then GoTo myNext

    checkDate = Format(Left(Split(myTable.innerText, "日期")(1), 10), "yyyy/mm/dd")

    If myCount = 0 Then DateEnd = checkDate

    If myCount + 1 = CInt(myNumber) Then DateStart = checkDate

    With clipboard

        .SetText myTable.outerHTML

        .PutInClipboard

    End With

    Cells(4, (myNumber - 1 - myCount) * 15 + 1).Select

    ActiveSheet.PasteSpecial NoHTMLFormatting = True

    

    myCount = myCount + 1

myNext:

    myDate = myDate - 1

    Application.Wait Now() + TimeValue("00:00:03")

Loop Until myCount = CInt(myNumber)

End With

Range("A1") = "資料範圍:"

Range("A2") = DateStart & "~" & DateEnd

Set myXML = Nothing

End Sub

Function convertraw(rawdata)

Dim rawstr

Set rawstr = CreateObject("adodb.stream")

With rawstr

.Type = 1

.Mode = 3

.Open

.Write rawdata

.Position = 0

.Type = 2

.Charset = "UTF-8"

convertraw = .ReadText

.Close

End With

Set rawstr = Nothing

End Function