[Excel VBA] 從 Yam 天空財金網匯入「券商進出」資料 - 返回最初的純真性情

字體：小中大

[Excel VBA] 從 Yam 天空財金網匯入「券商進出」資料

2009/05/01 22:26:05瀏覽14930｜回應4｜推薦0

應網友的要求寫了這個程式，底下 SaveTrans() 會新增一張工作表，然後從 Yam 天空財金網站把指定股號的 (當日) "券商進出" 資料匯入工作表，用法就像 GetTransInfo() 裡的方式。

Sub GetTransInfo()
SaveTrans ("2412")
SaveTrans ("2330")
End Sub

Sub SaveTrans(stockNo As String)
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;http://yamstock.megatime.com.tw/asp/stockinfo/ps_top.asp?m=all&stockid=" & _
    stockNo & "&name1=D2&index1=6", _    Destination:=ActiveSheet.Range("A1"))
    .Name = "Part1"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "8"
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With

With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;http://yamstock.megatime.com.tw/asp/stockinfo/ps_top.asp?m=all&stockid=" & _
    stockNo & "&name1=D2&index1=6" , _
    Destination:=ActiveSheet.Range("A3"))
    .Name = "Part2"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "10"
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With

RowToCut = ActiveSheet.[A65536].End(xlUp).Row + 1

With ActiveSheet.QueryTables.Add(Connection:= _
    "URL;http://yamstock.megatime.com.tw/asp/stockinfo/ps_top.asp?m=all&stockid=" & _
    stockNo & "&name1=D2&index1=6" _
    , Destination:=ActiveSheet.[A65536].End(xlUp).Offset(1, 0))
    .Name = "Part3"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlSpecifiedTables
    .WebFormatting = xlWebFormattingNone
    .WebTables = "11"
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With

Rows(RowToCut).Delete Shift:=xlUp

End Sub

( ｜ )


	回應文章