[發問] 如何可以指定日期後下載資料

pupai

您好
我希望程式可以依照我想要的日期下載當天資料
可以幫我指導修改
謝謝!!

1. Option Explicit
   
2. Sub EX()
   
3.    
   
4.    
   
5. Dim URL As String, xCo_Id As String, xSyear As String, xSseason As String
   
6.       
   
7.        xCo_Id = Range("B1").Value
   
8.        xSyear = Range("B2").Value
   
9.        xSseason = Range("B3").Value
   
10.       
    
11. 'xCo_Id = "[" & """年度""" & "," & """102年""" & "]"
    
12. '要求輸入網頁的參數:年度
    
13. 'xSyear = "[" & """月份""" & "," & """月 """ & "]"
    
14. 'Format(Date, "e")->中華民國的月份
    
15. 'xSseason = "[" & """日""" & "," & """日期""" & "]"
    
16. 'Format(Date, "q")->當年度的日期
    
17. 
    
18. 
    
19. '外資及陸資買賣超彙總表
    
20. URL = "URL;http://www.twse.com.tw/ch/trading/fund/TWT38U/TWT38U.php?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
    
21.     With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("D4"))
    
22.         .AdjustColumnWidth = False                   '自動調整欄寬
    
23.         .WebSelectionType = xlSpecifiedTables
    
24.         .WebFormatting = xlWebFormattingNone
    
25.         .WebTables = "2"
    
26.         .WebPreFormattedTextToColumns = True
    
27.         .WebConsecutiveDelimitersAsOne = True
    
28.         .WebSingleBlockTextImport = False
    
29.         .WebDisableDateRecognition = False
    
30.         .WebDisableRedirections = False
    
31.         .Refresh BackgroundQuery:=False
    
32. End With
    
33. 
    
34. '投信買賣超彙總表
    
35. URL = "URL;http://www.twse.com.tw/ch/trading/fund/TWT44U/TWT44U.php?step=1&CO_ID=" & xCo_Id & "&SYEAR=" & xSyear & "&SSEASON=" & xSseason & "&REPORT_ID=C"
    
36.     With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("K5"))
    
37.         
    
38.         .AdjustColumnWidth = False                   '自動調整欄寬
    
39.         .WebSelectionType = xlSpecifiedTables
    
40.         .WebFormatting = xlWebFormattingNone
    
41.         .WebTables = "2"
    
42.         .WebPreFormattedTextToColumns = True
    
43.         .WebConsecutiveDelimitersAsOne = True
    
44.         .WebSingleBlockTextImport = False
    
45.         .WebDisableDateRecognition = False
    
46.         .WebDisableRedirections = False
    
47.         .Refresh BackgroundQuery:=False
    
48.         
    
49.     End With
    
50. 
    
51.       
    
52. End Sub

複製代碼

GBKEE

回復 1# pupai
每一網頁的元素會有所不同.

1. Option Explicit
   
2. Sub 外資及陸資買賣超彙總表()
   
3.     Dim URL As String, xDate As Date
   
4.     xDate = Format(Date-1, "E/M/D")
   
5.     URL = "URL;http://www.twse.com.tw/ch/trading/fund/TWT38U/TWT38U.php?qdate=" & xDate
   
6.     With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=ActiveSheet.Range("a1"))
   
7.         .WebSelectionType = xlSpecifiedTables
   
8.         .WebFormatting = xlWebFormattingNone
   
9.         .WebTables = "5"
   
10.         .WebPreFormattedTextToColumns = True
    
11.         .WebConsecutiveDelimitersAsOne = True
    
12.         .WebSingleBlockTextImport = False
    
13.         .WebDisableDateRecognition = False
    
14.         .WebDisableRedirections = False
    
15.         .Refresh BackgroundQuery:=False
    
16.     End With
    
17. End Sub
    
18. Sub 投信買賣超彙總表()
    
19.     Dim URL As String, xDate As Date
    
20.     xDate = Format(Date-1, "E/M/D")
    
21.     URL = "URL;http://www.twse.com.tw/ch/trading/fund/TWT44U/TWT44U.php?qdate=" & xDate
    
22.     With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=ActiveSheet.Range("D4"))
    
23.         .Connection = URL
    
24.         .WebSelectionType = xlSpecifiedTables
    
25.         .WebFormatting = xlWebFormattingNone
    
26.         .WebTables = "5"
    
27.         .WebPreFormattedTextToColumns = True
    
28.         .WebConsecutiveDelimitersAsOne = True
    
29.         .WebSingleBlockTextImport = False
    
30.         .WebDisableDateRecognition = False
    
31.         .WebDisableRedirections = False
    
32.         .Refresh BackgroundQuery:=False
    
33.     End With
    
34. End Sub

複製代碼

pupai

回復 2# GBKEE


    版主
請教為什麼程式跑不出東西
謝謝

GBKEE

回復 3# pupai

1. Option Explicit
   
2. Sub 外資及陸資買賣超彙總表()
   
3.     Dim URL As String, xDate As Date
   
4.     xDate = Date - 1   '經查: 外資及陸資買賣超彙總表 提供前一營業日的資料
   
5. ReDate:
   
6.     URL = "URL;http://www.twse.com.tw/ch/trading/fund/TWT38U/TWT38U.php?qdate=" & Format(xDate, "E/M/D")
   
7.     With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=ActiveSheet.Range("a1"))
   
8.         .WebSelectionType = xlSpecifiedTables
   
9.         .WebFormatting = xlWebFormattingNone
   
10.         .WebTables = "5"
    
11.         .WebPreFormattedTextToColumns = True
    
12.         .WebConsecutiveDelimitersAsOne = True
    
13.         .WebSingleBlockTextImport = False
    
14.         .WebDisableDateRecognition = False
    
15.         .WebDisableRedirections = False
    
16.         .Refresh BackgroundQuery:=False
    
17.         If Application.CountA(.ResultRange) = 0 Then '非營業日,沒有資料.
    
18.             xDate = xDate - 1                        '往後退一日
    
19.             GoTo ReDate
    
20.         End If
    
21.     End With
    
22. End Sub

複製代碼

pupai

回復 4# GBKEE


感謝   
不懂的很多 但學到也很多
謝謝!!