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

Lan-Jerome wrote:
我想請教358樓問題
日期無法更新
"日期無法更新，請稍後再試"

Lan-Jerome wrote:
我自己檢查認為是請問大大看看對不對 Update_TDCC_day這個功能裡.responsetext抓不到資料

snare wrote:
2020-05-24 0:20 測試(686樓)，可正常下載
(因vba優先檢查日期清單，所以當網站暫時維護中、改版，都會出日期無法更新的錯誤訊息)

aaroncow wrote:
我想抓https://mops.twse.com.tw/mops/web/t138sb02_q1
每月自結損益的報告，實際網址該怎麼取得?
我想抓三間公司，目前卡在無法取得網址.....(恕刪)

Url = "https://mops.twse.com.tw/mops/web/ajax_t138sb02"
Url_a = "https://mops.twse.com.tw/mops/web/t138sb02_q1"
Url_b = "encodeURIComponent=1&run=Y&step=1&CK2=1&BK1=2&TYPEK=sii&YEAR=108&COMP=2002&firstin=true"

clothk73713 wrote:
sub test
Workbooks("3325").Worksheets(1).Range("A1").Value = "Hello"
Workbooks("5201").Worksheets("vba").Range("A1").Value = "Hello"
end sub

Sub test()
    
    Dim w1 As Excel.Workbook
    Dim w2 As Excel.Workbook
    
    Set w1 = Workbooks.Open(ThisWorkbook.Path & "\" & "3325.xlsx", , False)
    Set w2 = Workbooks.Open(ThisWorkbook.Path & "\" & "5201.xlsx", , False)
    
    w1.Sheets(1).Range("a1").Value = Now()
    w2.Sheets("vba").Range("a1").Value = Timer
    
    Application.DisplayAlerts = False
    w1.Close 1
    w2.Close 1
    Application.DisplayAlerts = True
    
    Set w1 = Nothing
    Set w2 = Nothing
    
End Sub

snare wrote:
Sub test()(恕刪)

clothk73713 wrote:
我哪裡的想法錯了嗎

Sub test()
    
    Dim URL(2) As String
    Dim w1 As Excel.Workbook
    Dim w2 As Excel.Workbook
    
    Set HTMLsourcecode = CreateObject("htmlfile")
    Set GetXml = CreateObject("msxml2.xmlhttp")
    
    Set w1 = Workbooks.Open(ThisWorkbook.Path & "\" & "3325.xlsm", , False)
    Set w2 = Workbooks.Open(ThisWorkbook.Path & "\" & "5201.xlsm", , False)
    
    Application.Wait (Now + TimeValue("0:00:5"))
    
    URL(1) = "https://goodinfo.tw/StockInfo/ShowK_Chart.asp?STOCK_ID=3325&CHT_CAT2=week"
    URL(2) = "https://goodinfo.tw/StockInfo/ShowK_Chart.asp?STOCK_ID=5201&CHT_CAT2=week"
    
    With GetXml
        .Open "GET", URL(1), False
        .setRequestHeader "Cache-Control", "private"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/83.0.4103.116 Safari/537.36"
        .send

        HTMLsourcecode.body.innerhtml = .responsetext
        
        Set Table = HTMLsourcecode.all.tags("table")(23).Rows
        For i = 0 To Table.Length - 1
            For j = 0 To Table(i).Cells.Length - 1
                w1.Sheets("vba").Cells(i + 1, j + 1) = Table(i).Cells(j).innertext
            Next j
        Next i
    
        
        .Open "GET", URL(2), False
        .setRequestHeader "Cache-Control", "private"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; Win64; x64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/83.0.4103.116 Safari/537.36"
        .send

        HTMLsourcecode.body.innerhtml = .responsetext

        Set Table = HTMLsourcecode.all.tags("table")(23).Rows
        For i = 0 To Table.Length - 1
            For j = 0 To Table(i).Cells.Length - 1
                w2.Sheets("vba").Cells(i + 1, j + 1) = Table(i).Cells(j).innertext
            Next j
        Next i
        
    
    End With
    
    
    Application.DisplayAlerts = False
    w1.Close 1
    w2.Close 1
    Application.DisplayAlerts = True
    
    Set w1 = Nothing
    Set w2 = Nothing
    Set HTMLsourcecode = Nothing
    Set GetXml = Nothing
    
    'ThisWorkbook.Close True
    
End Sub

snare wrote:
優先順序錯了Sub test...(恕刪)