Excel VBA 自動抓取期交所 期貨每日交易行情

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

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

這次的程式是可以依據使用者輸入的日期
來抓到當天的期貨資料

Sub test()

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}")

ReDim myArr(1 To 10, 1 To 20)

dateLR = Cells(Rows.Count, "A").End(xlUp).Row

With myXML
 
    For dateRow = 6 To dateLR
        Application.Wait Now() + TimeValue("00:00:03")
        myM = Format(Month(Cells(dateRow, "A")), "00")
        myD = Format(Day(Cells(dateRow, "A")), "00")
     
        .Open "POST", "http://www.taifex.com.tw/chinese/3/3_1_1.asp", False
        .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
        .send "qtype=2&commodity_id=TX&commodity_id2=&market_code=0&goday=&dateaddcnt=0&DATA_DATE_Y=2018&DATA_DATE_M=05&DATA_DATE_D=22&syear=2018&smonth=" & myM & "&sday=" & myD & "&datestart=2018%2F05%2F15&MarketCode=0&commodity_idt=TX&commodity_id2t=&commodity_id2t2="
     
        myHTML.body.innerHTML = convertraw(.responseBody)
        'Debug.Assert InStr(1, myText, "10368") <> 0
     
        Set myTables = myHTML.getElementsByTagName("table")
        i = 1
        For Each myTable In myTables
            If myTable.getAttribute("width") = 965 Then
         
                textLR = Cells(Rows.Count, "D").End(xlUp).Row
                textLR = IIf(textLR = 1, 5, textLR + 5)
                Cells(textLR, 4).Select
                Cells(textLR - 1, 4) = myTable.PreviousSibling.innerText
                Cells(textLR - 1, 4).WrapText = False
                With clipboard
                    .SetText myTable.outerHTML
                    .PutInClipboard
                End With
                Sheets("工作表1").PasteSpecial NoHTMLFormatting:=False

                Exit For
            End If
        Next
     
    Next
End With
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