Dim ie As Object '模組最頂端 Dim 供這模組的程序使用的變數
Sub AllFile()
Dim i As Integer, v, Y As Integer, S As String
Set ie = CreateObject("internetexplorer.application") '使用此方式可以免除 "設定引用項目"
GetDividend (2330)
End Sub
Private Sub GetDividend(ByVal ss As String) '取股利網頁
Dim strText As String
Dim i As Integer, j As Integer, xTable As Object
With CreateObject("msxml2.xmlhttp")
.Open "GET", "http://pscnetinvest.moneydj.com.tw/z/zc/zcq/zcqa/zcqa_" & ss & ".djhtm", False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.send
strText = BinToStr(.responseBody, "BIG5") '要注意網頁編碼
End With
With CreateObject("htmlfile")
.Write strText
Set xTable = .all.tags("table")(2)
With Sheet2
.Cells.Clear
For i = 0 To xTable.Rows.Length - 1
For j = 0 To xTable.Rows(i).Cells.Length - 1
.Cells(i + 1, j + 1) = xTable.Rows(i).Cells(j).innertext
Next
Next
End With
End With
End Sub
Function BinToStr(arrBin, strChrs)
With CreateObject("ADODB.Stream")
.Type = 2
.Open
.Writetext arrBin
.Position = 0
.Charset = strChrs
BinToStr = .ReadText
.Close
End With
End Function作者: wufonna 時間: 2019-6-11 16:39
table 包裹著 form ,可能是故意防止人複製的，網頁才這麼寫，請教 大大如何修改，謝謝作者: n7822123 時間: 2019-6-14 03:02
Sub get_stock()
Dim Url, HTMLsourcecode, GetXml
Set HTMLsourcecode = CreateObject("htmlfile")
Set GetXml = CreateObject("msxml2.xmlhttp")
Url = "http://pscnetinvest.moneydj.com.tw/z/zc/zcq/zcqa/zcqa_2330.djhtm"
With GetXml
.Open "GET", Url, False
.Send
HTMLsourcecode.body.innerhtml = .Responsetext
Set Table = HTMLsourcecode.all.tags("table")(2).Rows
For i = 0 To Table.Length - 1
For j = 0 To Table(i).Cells.Length - 1
ActiveSheet.Cells(i + 1, j + 1) = Table(i).Cells(j).innertext
Next j
Next i
End With
Set HTMLsourcecode = Nothing '釋放記憶體
Set GetXml = Nothing
End Sub '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~作者: wufonna 時間: 2019-6-15 09:11
