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"
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
關閉廣告