麻辣家族討論版版 - Powered by Discuz! Board

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

複製代碼