Excel VBA - 如何下載交易所之三大法人買賣超日報表

使用Excel VBA抓取交易所之三大法人買賣超日報表



Sub Ex_T86()
    Dim i As Integer, s As Integer, k As Integer, A, ii, j
    Dim my_url As String
    '
    ' 上市之三大法人買賣報表(日)
    '
    my_url = "http://www.twse.com.tw/ch/trading/fund/T86/T86.php"
    ' ========================================
    '
    '  以下內容，須研究網頁原始碼
    '  主要是 input / select /submit 等關鍵字
    '
    ' ========================================
    '
    ' Step 1 - 填入日期
    '
    Dim input_date As String 'Input - 資料日期
    input_date = "102/10/16"
    '
    ' ===================================
    '
    ' Step 2 - 選擇資料分類
    '
    Dim select2 As String 'Select - 分類項目
    select2 = "ALLBUT0999"
    ' value='ALL'        >全部
    ' value='ALLBUT0999' >全部(不含權證、牛熊證)
    ' ===============================
    '
    ' Step 3 - 選擇排序方法
    '
    Dim sorting As String '排序方法
    sorting = "by_stkno"
    ' 依買賣超股數排列
    ' 依證券代號排列
    ' =========================================
    '
    ' Step 4 - 按下"查詢"鍵  
    '
    Dim login_btn As String
    login_btn = " 查詢 "
    '
    '
    ' ========================================
    '
    '  以下為模擬使用網頁的動作
    '
    ' ========================================
    With CreateObject("InternetExplorer.Application")
        .Visible = True
        .Navigate my_url
        Do While .Busy Or .ReadyState <> 4: DoEvents: Loop
        With .document
            '
            ' Step 1 - 填入日期
            '
            For Each A In .getelementsbytagname("INPUT")
                If A.Name = "input_date" Then A.Value = input_date
            Next
            '
            ' Step 2 - 選擇資料分類
            '
            For Each A In .getelementsbytagname("SELECT")
                '
                ' isnew
                '
                If A.Name = "select2" Then A.Value = select2
            Next
            '
            ' Step 3 - 選擇排序方法
            '
            For Each A In .getelementsbytagname("INPUT")
                If A.Name = "sorting" Then A.Value = sorting
            Next
            '
            ' Step 4 - 按下"查詢"鍵  
            '
            For Each A In .getelementsbytagname("INPUT")
                If Trim(A.Value) = "查詢" And A.Name = "login_btn" Then A.Click
            Next
        End With
        Application.Wait Now + #12:00:30 AM#                     '等待網頁下載資料，有時要長一點
        ' ===================
        '
        ' 將網頁資料轉出至CSV
        '
        ' ===================
        Dim my_csvfile As String
        Dim my_FNo As String
        my_csvfile = "D:\My_Files\My_Programming\PubInfo_CSV_TWII_T86\T86_20131016.csv" '依個人需求設定
        my_FNo = FreeFile
        Open my_csvfile For Output As #my_FNo
        '
        Set A = .document.getelementsbytagname("table")
        On Error Resume Next       '***有些table沒Rows資料會產生錯誤 不理會它,程式繼續走
        '
        With ActiveSheet
           .Cells.Clear
           '************************
           ' For ii = 0 To A.Length - 1        '不知道table範圍在何處: 從0開始
           '    k = k + 1
           '    Cells(k, 1) = "Table" + Str(ii)
           '******************************
            ii = 8
            For i = 2 To A(ii).Rows.Length - 1      '寫入資料 , 0,1為標題列，不寫 (各網頁或有不同)
               'Debug.Print ii  '可找出所要資料的 table 範圍
               'k = k + 1
               'For j = 0 To 8 ' 8是該表的欄位數，從0開始算
               Write #my_FNo, A(ii).Rows(i).Cells(0).innerText, _
               A(ii).Rows(i).Cells(1).innerText, _
               A(ii).Rows(i).Cells(2).innerText, _
               A(ii).Rows(i).Cells(3).innerText, _
               A(ii).Rows(i).Cells(4).innerText, _
               A(ii).Rows(i).Cells(5).innerText, _
               A(ii).Rows(i).Cells(6).innerText, _
               A(ii).Rows(i).Cells(7).innerText, _
               A(ii).Rows(i).Cells(8).innerText
               '    Cells(k, j + 1) = temp
               'Next j
             
            Next i
            Close #my_FNo
        End With
        .Quit        '關閉網頁
    End With
End Sub