- 帖子
- 40
- 主題
- 11
- 精華
- 0
- 積分
- 100
- 點名
- 0
- 作業系統
- Win8
- 軟體版本
- Office2013
- 閱讀權限
- 20
- 性別
- 男
- 來自
- Taiwan
- 註冊時間
- 2014-12-9
- 最後登錄
- 2021-7-2
 
|
想要此程式的結果 , 所以Copy來運用 , 但執行時都出現在 Dim myDOC As HTMLDocument 這行 , 顯示"使用者自定型態尚未定義"的問題而中斷 ,
請問這要如何去解決呀 ?? TKS .
Sub 年度股價_上櫃(StockNo)
theURL = "http://www.tpex.org.tw/web/stock/statistics/monthly/result_st42.php?timestamp=1405008334769"
Dim XMLHTTP
Set XMLHTTP = CreateObject("microsoft.xmlhttp")
Dim result As Variant
Dim TargetSheet As String
Dim myDOC As HTMLDocument
'存放HTML表格資料之工作表
TargetSheet = "YearPrice"
With XMLHTTP
.Open "POST", theURL, False
.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
.setRequestHeader "Content-length", 45
.setRequestHeader "Connection", "close"
.send "ajax=true&input_stock_code=" & StockNo
End With
'建立 HTML Document 物件
Set myDOC = New HTMLDocument
'將XMLHTTP的抓到資料倒入myDOC物件
myDOC.body.innerHTML = XMLHTTP.responseText
Set XMLHTTP = Nothing
'取得所有表格
Dim HTML_ALL_TABLE As Variant
Dim myTable As HTMLTable
Dim myRow As HTMLTableRow
Dim myCell As HTMLTableCell
'清除上一檔的股價
Sheets(TargetSheet).[A1:T200].ClearContents
Set myTable = myDOC.getElementsByTagName("TABLE").Item(2) '2014/01/03改
Debug.Print myTable.innerHTML
'判斷有無股價資料之狀況
If myTable Is Nothing Then Exit Sub
'將股價資料抄到temp工作表
r = 2
For Each myRow In myTable.Rows
c = 0
For Each myCell In myRow.Cells
c = c + 1
If c = 6 Or c = 8 Then
Sheets(TargetSheet).Cells(r, c) = "'" & myCell.innerText
Else
Sheets(TargetSheet).Cells(r, c) = myCell.innerText
End If
DoEvents
Next
r = r + 1
Next
End Sub |
|