麻辣家族討論版版 - Powered by Discuz! Board

Option Explicit
Sub Ex()
Workbooks.Open Filename:="http://www.otc.org.tw/ch/stock/margin_trading/margin_balance/margin_bal_download.php?d=103/01/03&s=0"
End Sub

複製代碼

Option Explicit
Sub Ex()
Dim Theurl As String, Sdate
Theurl = "http://www.otc.org.tw/ch/stock/margin_trading/margin_balance/margin_bal_download.php?d=" & Sdate & "&s=0"
With ActiveSheet.QueryTables.Add(Connection:="URL;" & Theurl, Destination:=Range("b1"))
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.RefreshPeriod = 0
.AdjustColumnWidth = False
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
'.WebTables = "1,2,3,4"
.WebDisableDateRecognition = True '關閉日期辨識
.Refresh BackgroundQuery:=False
.ResultRange.Columns(1).TextToColumns Destination:=.ResultRange.Cells(1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
(20, 1)), TrailingMinusNumbers:=True
'TextToColumns 方法 (資料剖析)的參數可錄製得到
'ResultRange.Columns(1):weby資料的第一欄
'ResultRange.Cells(1) :weby資料的第一個Cells(儲存格)
.Delete
End With
End Sub
Sub Ex1()
Dim Theurl As String, Sdate, AR
Sdate = "103/01/03"
Theurl = "http://www.otc.org.tw/ch/stock/margin_trading/margin_balance/margin_bal_download.php?d=" & Sdate & "&s=0"
With Workbooks.Open(Theurl)
AR = .Sheets(1).UsedRange
.Close False
End With
With ActiveSheet
.UsedRange.Clear
.Range("A1").Resize(UBound(AR, 1), UBound(AR, 2)) = AR
End With
End Sub

複製代碼

Sub EXC()
Dim Theurl As String, Sdate
Dim URL As String, xDate As Date, A As Date
A = Range("A1").Value
xDate = Format(A, "E/M/D")
Theurl = "http://www.otc.org.tw/ch/stock/3insti/DAILY_TradE/3itrade_download.php?t=D&d=& xDate &s=0"
With ActiveSheet.QueryTables.Add(Connection:="URL;" & Theurl, Destination:=Range("A2"))
.BackgroundQuery = True
.RefreshStyle = xlOverwriteCells
.RefreshPeriod = 0
.AdjustColumnWidth = False
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
'.WebTables = "1,2,3,4"
.WebDisableDateRecognition = True '關閉日期辨識
.Refresh BackgroundQuery:=False
.ResultRange.Columns(1).TextToColumns Destination:=.ResultRange.Cells(1), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
(20, 1)), TrailingMinusNumbers:=True
'TextToColumns 方法 (資料剖析)的參數可錄製得到
'ResultRange.Columns(1):weby資料的第一欄
'ResultRange.Cells(1) :weby資料的第一個Cells(儲存格)
.Delete
End With
End Sub

複製代碼

Sub EXC()
Dim Theurl As String, Sdate
Dim URL As String, xDate As String, A As Date
A = Range("A1").Value
xDate = Format(A, "E/MM/DD")
Theurl = "http://www.otc.org.tw/ch/stock/3insti/DAILY_TradE/3itrade_download.php?t=D&d=" & xDate & "&s=0"

複製代碼

Sub E()
Dim URL As String, xDate As Date, A As Date
A = Range("A2").Value
xDate = Format(A, "E/M/D")
ReDate:
URL = "URL; http://www.twse.com.tw/ch/trading/fund/T86/T86.php?qdate=" & xDate
With ActiveSheet.QueryTables.Add(Connection:=URL, Destination:=Range("B1"))
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "5"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub

複製代碼