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

S大你好
今天終於提起勇氣發問,因我正摸索VBA,這版對我這新手真是一大寶藏,有很多學習的地方
真的感謝大大提供。
我想請教358樓問題
日期無法更新
"日期無法更新,請稍後再試"
我自己檢查認為是請問大大看看對不對 Update_TDCC_day這個功能裡.responsetext抓不到資料
請問要怎麼改?麻煩大大抽空回答,謝謝!!
Lan-Jerome wrote:
我想請教358樓問題
日期無法更新
"日期無法更新,請稍後再試"





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


雖然358樓是改版前的無法下載的程式碼,不過能知道問題所在,您也很厲害了


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

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

挖勒~~居然沒發現這樓
感謝S大的幫助,謝謝
請問樓主
我想抓https://mops.twse.com.tw/mops/web/t138sb02_q1
每月自結損益的報告,實際網址該怎麼取得?
我想抓三間公司,目前卡在無法取得網址..
能否提示一下嗎
感謝
aaroncow wrote:
我想抓https://mops.twse.com.tw/mops/web/t138sb02_q1
每月自結損益的報告,實際網址該怎麼取得?
我想抓三間公司,目前卡在無法取得網址.....(恕刪)


寫法同778樓

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"


版主 我想請問一下 如果要在同一個vba里執行 兩個活頁簿的工作是不是無法做到

程式碼如下

sub test

Workbooks("3325").Worksheets(1).Range("A1").Value = "Hello"

Workbooks("5201").Worksheets("vba").Range("A1").Value = "Hello"

end sub
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()(恕刪)


版主大神 抱歉我寫不出來 我原本想說跟你問個原理我想自己試試看 結果踢到鐵板寫了好久都寫不出來
寫出來的結果出現執行時發生陣列超出索引範圍 我是直接使用
URL(1) :
Woorkbooks("3205").Worksheets("vba").Cells(i + 1, j + 1) = Table(i).Cells(j).innertext
URL(2):
Woorkbooks("5201").Worksheets("vba").Cells(i + 1, j + 1) = Table(i).Cells(j).innertext

以下為我自己融合您回覆我的完整程式碼 抱歉大神請您在幫我過目一下 我哪裡的想法錯了嗎

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")
Application.DisplayAlerts = False
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=3325&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
Set w1 = Workbooks.Open(ThisWorkbook.Path & "\" & "3325.xlsm", , False)
For i = 0 To Table.Length - 1
For j = 0 To Table(i).Cells.Length - 1
w1.Worksheets("vba").Cells(i + 1, j + 1) = Table(i).Cells(j).innertext
Next j
Next i
End With
With GetXml
.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 w2 = Workbooks.Open(ThisWorkbook.Path & "\" & "5201.xlsm", , False)
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.Worksheets("vba").Cells(i + 1, j + 1) = Table(i).Cells(j).innertext
Next j
Next i
Application.DisplayAlerts = False
w1.Close 1
w2.Close 1
Application.DisplayAlerts = True
Set w1 = Nothing
Set w2 = Nothing
End With
ThisWorkbook.Close True '關閉運行vba的活頁簿 True 存檔 flase 不存檔
End Sub
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...(恕刪)


可以用了 版主大神感恩 我學到了
關閉廣告
文章分享
評分
評分
複製連結
請輸入您要前往的頁數(1 ~ 143)

今日熱門文章 網友點擊推薦!