Board logo

標題: [發問] 如何排除問題 ? [打印本頁]

作者: oliwa    時間: 2015-12-8 22:53     標題: 如何排除問題 ?

想要此程式的結果 , 所以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
作者: c_c_lai    時間: 2015-12-9 07:32

回復 1# oliwa
需加入:
[attach]22759[/attach]
作者: oliwa    時間: 2015-12-11 07:36

謝謝回覆 , 問題已解決了...................




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)