iInfo 資訊交流: MultiCharts 匯入外部資料(1) --- Excel VBA 產生的外資未平倉量檔案

MultiCharts 匯入外部資料(1) --- Excel VBA 產生的外資未平倉量檔案

這1~2天裡，玩了一些MultiCharts與Excel VBA相關的應用，其中一項就是匯入外資期貨未平倉口數，這一部分在網路上寫的人很少，基於此筆者也順道將做法一併整理出來，幫助有需要的朋友們。
期交所每日都會公佈三大法人期貨交易資訊，其中大家最為熟知的就是外資未平倉量，因為外資未平倉量具有一定的參考價值，所以有很多做程式交易的朋友也常拿這部分的資料來做為進程式策略出場的依據，以下就來介紹如何匯入外資未平倉量。

由於期交所的資料只能抓到前三年的資料，其餘的資料都需要花錢購買，不過這樣的資料量也足以應付了，使用以下的Excel VBA程式去抓取期交所未平倉資料。
稍微解釋一下Excel VBA程式的功能。

抓取三大法人的未平倉口數。
挑選外資未平倉口數並複製到工作表中。
整理可以餵給MultiCharts QuoteManager的格式。
最後輸出成CSV檔案。

Option Explicit

Const xlFilePath As String = "C:\期貨下載資料\"

Sub 執行()
    Application.ScreenUpdating = False
    取得外資未平倉量抓3年
    整理欄位與補0
    輸出CSV
    Application.ScreenUpdating = True
End Sub

Sub 取得外資未平倉量抓3年()
    Dim url As String
    Dim i, xlCount, nsYear, nsMonth, nsDay, neYear, neMonth, neDay As Integer
    Dim strFilename As String
    Dim Tempsheet
    Dim Rng As Range
    
    If Dir(xlFilePath, vbDirectory) = "" Then
        MkDir (xlFilePath)
    End If
        
    With Workbooks(1).Sheets("外資未平倉量")
        .UsedRange.ClearContents
    End With
        
    For i = 0 To 5
        nsYear = Format(Year(Date) - 3, "0000")
        nsMonth = Format(Month(Date), "00")
        nsDay = Format(Day(Date), "00")
        
        neYear = Format(Year(Date), "0000")
        neMonth = Format(Month(Date), "00")
        neDay = Format(Day(Date) - i, "00")
        
        url = "http://www.taifex.com.tw/chinese/3/7_12_8dl.asp?goday=&syear=" & nsYear & "&smonth=" & nsMonth & "&sday=" & nsDay & "&eyear=" & neYear & "&emonth=" & neMonth & "&eday=" & neDay & "&COMMODITY_ID=TXF"
    
        strFilename = xlFilePath + "期貨.csv"
        
        下載檔案 url, strFilename
        
        With Workbooks.Open(strFilename)
            If InStr(1, .ActiveSheet.Range("A1"), "DOCTYPE") = 0 Then
                .Close 0
                Exit For
            End If
            .Close 0
        End With
    Next
    
    With Workbooks.Open(strFilename)
                    
        Set Rng = .ActiveSheet.UsedRange
                    
        .ActiveSheet.AutoFilterMode = False
        
        With Rng
           .AutoFilter
           .AutoFilter Field:=3, Criteria1:="外資及陸資"
        End With
        
        Set Tempsheet = Workbooks(1).Worksheets("外資未平倉量")
         
        xlCount = .ActiveSheet.Range("A65536").End(xlUp).Row
        
        .ActiveSheet.Range("A2:A" & xlCount).Copy Destination:=Tempsheet.Range("A1")
        .ActiveSheet.Range("N2:N" & xlCount).Copy Destination:=Tempsheet.Range("E1")
        
        Set Tempsheet = Nothing
        Set Rng = Nothing
        
        .Close 0
    End With
End Sub

Sub 整理欄位與補0()
    Dim i As Integer
    Dim nCount As Integer
    
    With Sheets("外資未平倉量")
        nCount = .Range("A65536").End(xlUp).Row
        For i = 1 To nCount
            If .Cells(i, 5) > 0 Then
                .Cells(i, 4) = .Cells(i, 5)
            Else
                .Cells(i, 3) = .Cells(i, 5)
            End If
        Next
        
        For i = 1 To nCount
            If .Cells(i, 2) = Empty Then
                .Cells(i, 2) = 0
            End If
            If .Cells(i, 3) = Empty Then
                .Cells(i, 3) = 0
            End If
            If .Cells(i, 4) = Empty Then
                .Cells(i, 4) = 0
            End If
        Next
    End With
End Sub

Sub 輸出CSV()
        Workbooks.Add
        Workbooks(1).Sheets("外資未平倉量").Cells.Copy Destination:=Workbooks(2).Sheets(1).Range("A1")
        Application.DisplayAlerts = False
        Workbooks(2).Sheets(1).SaveAs ThisWorkbook.Path & "\外資未平倉量.csv", FileFormat:=xlCSV, CreateBackup:=False
        Application.DisplayAlerts = True
        Workbooks(2).Close 0
End Sub

Sub 下載檔案(url As String, xlFilename As String)
    Dim oXMLHTTP, objStream As Object
    
    Set oXMLHTTP = CreateObject("Microsoft.XMLHTTP")
    Set objStream = CreateObject("ADODB.stream")
            
    With oXMLHTTP
        .Open "POST", url, False
        .send
        
        If .readyState = 4 Then '.Status = 200
            With objStream
                .Type = 1
                .Open
                .Write oXMLHTTP.ResponseBody
                
                If Dir(xlFilename) <> "" Then Kill xlFilename
                .SaveToFile xlFilename
                .Close
            End With
        End If
    End With

    Set oXMLHTTP = Nothing
    Set objStream = Nothing
End Sub

外資未平倉量.xlsm下載

以上產的CSV檔格式要特別注意開盤價、最低價、最高價、收盤價的欄位。