(不定期更新)使用VBA解決 excel web 查詢無法匯入、匯入太慢的股市資料

snare wrote:
方法一因為網頁上的空(恕刪)

joehuang wrote:
url="https://www.ctbcbank.com/twrbo/zh_tw/dep_index/dep_ratequery/dep_foreign_rates.html"
屬[POST]方法:但好像也找不到像 825樓那樣 有 FROM DATA 可看到他的抓程式的參數部份
不知這種網站要如何判斷他要用那種方式來爬呢?

Sub test()
        
    Dim IE As Object, Url As String
    
    ActiveSheet.Cells.Clear
    Application.ScreenUpdating = False
     
    Set IE = CreateObject("InternetExplorer.Application")
    Url = "https://www.ctbcbank.com/twrbo/zh_tw/dep_index/dep_ratequery/dep_foreign_rates.html"
    
    With IE
        .Visible = True
        .Navigate Url
        Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
        
        Application.Wait (Now + TimeValue("0:00:10"))
        
        IE.ExecWB 17, 0
        IE.ExecWB 12, 2
        
        ActiveSheet.Cells(1, 1).Select
        ActiveSheet.PasteSpecial Format:="HTML", Link:=False, DisplayAsIcon:=False, NoHTMLFormatting:=True
        ActiveSheet.Rows("1:583").Delete Shift:=xlUp
        ActiveSheet.Rows("52:350").Delete Shift:=xlUp
        ActiveSheet.Cells(1, 1).Select
        
    End With
    
    IE.Quit
    Set IE = Nothing
    Application.ScreenUpdating = True
        
End Sub

Dylan67 wrote:
1.(恕刪) (我設了延遲)
2. 若以"迴圈方式"，則第2次迴圈會出現"陣列索引超出範圍"(恕刪)
4. 我總共用了CreateObject("htmlfile")、CreateObject("msxml2.xmlhttp")、CreateObject("Microsoft.XMLHTTP")這樣合理嗎?

Sub Post_Rs()

    Dim GetXml As Object, Clipboard As Object, RsEndRow As Integer, Url As String
    
    Set GetXml = CreateObject("msxml2.xmlhttp")
    Set Clipboard = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    Url = "https://mops.twse.com.tw/mops/web/ajax_t100sb02_1"
       
    With GetXml
        .Open "POST", Url, False
        .send (Sheets("Rs").Range("AH90").Value)
        Clipboard.SetText .responsetext
        Clipboard.PutInClipboard
    End With

    With Sheets("Rs")
        .Select
        RsEndRow = .Cells(Rows.Count, 27).End(xlUp).Row
        .Range("AA" & RsEndRow + 1).Select
        .PasteSpecial NoHTMLFormatting:=True
        .Cells(1, 1).Select
    End With
    
    Set GetXml = Nothing
    Set Clipboard = Nothing
     
End Sub

Dylan67 wrote:
snare大神：您的(恕刪)

snare wrote:
剛剛大概看了一下因為(恕刪)

Dylan67 wrote:
1、點擊[單次下載]第1次會出現不正確的格式，要第2次點擊才會正常
2、[迴圈方式]需要先點擊[單次下載]後，才能順利下載成正確格式
不理解為什麼？

snare wrote:
a、您提供的程式還是(恕刪)