返回列表 上一主題 發帖

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

pupai

帖子
184 
主題
45 
精華
0 
積分
407 
點名
0  
作業系統
WIN 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2010-8-19 
最後登錄
2024-11-1 

論壇贊助勳章
1# 跳轉到 » 正序看帖
打印
tT
發表於 2013-12-3 10:30 | 只看該作者

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

您好
我希望程式可以依照我想要的日期下載當天資料
可以幫我指導修改
謝謝!!
  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")->當年度的日期


  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

  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

  51.       
  52. End Sub
複製代碼
收藏 分享

pupai

帖子
184 
主題
45 
精華
0 
積分
407 
點名
0  
作業系統
WIN 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2010-8-19 
最後登錄
2024-11-1 

論壇贊助勳章
5#
發表於 2013-12-9 17:57 | 只看該作者
本帖最後由 GBKEE 於 2013-12-9 18:12 編輯

回復 4# GBKEE


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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
4#
發表於 2013-12-9 15:52 | 只看該作者
本帖最後由 GBKEE 於 2013-12-9 18:32 編輯

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

pupai

帖子
184 
主題
45 
精華
0 
積分
407 
點名
0  
作業系統
WIN 7 
軟體版本
office 2010 
閱讀權限
20 
性別
男 
註冊時間
2010-8-19 
最後登錄
2024-11-1 

論壇贊助勳章
3#
發表於 2013-12-9 09:49 | 只看該作者
回復 2# GBKEE


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

TOP

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
2#
發表於 2013-12-6 18:31 | 只看該作者
本帖最後由 GBKEE 於 2013-12-9 15:53 編輯

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 盡多少本份，就得多少本事。
返回列表 上一主題