Board logo

標題: [發問] 請教這表如何直接存入工作表??? [打印本頁]

作者: t8899    時間: 2019-5-31 21:38     標題: 請教這表如何直接存入工作表???

http://mops.twse.com.tw/mops/web/t108sb27
作者: t8899    時間: 2019-6-3 15:20

本帖最後由 t8899 於 2019-6-3 15:23 編輯

我查了舊文章,GBKEE版大這段程式碼執行後是空白的???執行到 A.Click 後就跳回首頁??
Option Explicit
Sub 公開資訊網頁()
    Dim A As Object, E As Object
    With CreateObject("InternetExplorer.Application")
        .Visible = False
    .Navigate "http://mops.twse.com.tw/mops/web/t164sb04"     '網址:綜合損益表
     ' .Navigate "http://mops.twse.com.tw/mops/web/stapap1"       '網址:董監事持股餘額明細資
'    .Navigate "http://mops.twse.com.tw/mops/web/t05st22" '網址:公開資訊觀測站-->營運概況-->財務比率分析->採IFRSs後->財務分析資料
        Do While .readyState <> 4 Or .Busy: DoEvents: Loop
         '   .document.getElementById("isnew").Value = "false"       '選擇: 歷史資料
            '註解上一行程式碼為 -> 選擇: 最新資料,不會執行 If 內程式碼
            If .Document.getElementById("isnew").Value = "false" Then
             .Document.getElementById("isnew").FireEvent ("onchange")
                .Document.getElementById("year").Value = "102"       '年度
                .Document.getElementById("season").Value = "01"    '綜合損益表:季別
                .Document.getElementById("month").Value = "08"      '董監事持股餘額明細資料:月份
            End If
            '********************************************************************
           For Each A In .Document.getelementSbyTAGNAME("INPUT")
                'If A.Name = "co_id" Then A.Value = "2317"
                 If A.Name = "co_id" Then A.Value = ActiveSheet.Range("A1") '儲存格:指定代號
                 If A.Value = " 搜尋 " Then A.Click                     '按下 搜尋
            Next
            Do While .readyState <> 4 Or .Busy: DoEvents: Loop
            For Each E In .Document.all.TAGS("div")
                If E.ID = "table01" Then
                    .Document.body.innerHTML = E.outerHTML
                    Do While .readyState <> 4 Or .Busy: DoEvents: Loop
                    .ExecWB 17, 2       '  Select All
                    .ExecWB 12, 2       '  Copy selection
                    With ActiveSheet
                        .UsedRange.Offset(1).Clear
                        .Cells(2, 1).Select
                        .PasteSpecial Format:="HTML"
                    End With
                End If
            Next
       .Quit                          '關閉 IE
    End With
End Sub




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