適材適所

PowerShellを中心にプログラミングやシステム管理の備忘録的なブログ

【VBA】ADOでCSVにアクセスする

はじめに

csvファイルをExcelに取り込むという、需要は地味にはびこっている気がします。

Power Queryなどの手段も増えてきましたが、VBAで簡単にできると便利です。

そんなときに役立つかも知れないちょっとしたADOを使ったコードを紹介します。

Openを用いたCSVへのアクセス

CSVへのアクセスは、テキストファイルを読むオーソドックスな方法でやるとコードがぐちゃぐちゃになりがちです。

例えばこんな感じ

Option Explicit
Sub readCsv1()
    Open "C:\data.csv" For Input As #1
    Dim line As String
    Dim j As Long: j = 0
    Dim writeRow As Long: writeRow = 1
    Do Until EOF(1)
        Line Input #1, line
        Dim splited As Variant: splited = Split(line, ",")
        Dim writeCol As Long: writeCol = 1
        Dim i As Long
        For i = 0 To UBound(splited)
            Cells(writeRow, writeCol) = splited(i)
            writeCol = writeCol + 1
        Next i
        writeRow = writeRow + 1
    Loop
    Close #1
    
End Sub

え、わざと汚くしている?そんなことはありません、多分・・・。

ADOを用いたCSVへのアクセス

こちらの記事で紹介したこのクラスを使ってみると、コードの可読性があがる、という話です。

Excel VBAでAccessへの接続をSQLで簡単に行う - 適材適所

ConnectionFactory.clsのみこんな感じに追加します。

'ConnectionFactory.cls
Option Explicit
    '--------------------------------------
    '参照設定
    'Microsoft ActiveX Data Object RecordSet
    'Microsoft Scripting Runtime
    'Microsoft ActiveX Data Object
    '---------------------------------------
'追加
    Const CSVPROVIDER_HDRYES As String = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=<SOURCE>;Extended Properties=""text;HDR=YES;FMT=Delimited;"";"
    Const CSVPROVIDER_HDRNO  As String = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=<SOURCE>;Extended Properties=""text;HDR=NO;FMT=Delimited;"";"

   Const ACPROVIDER As String = "Provider=Microsoft.Ace.OLEDB.12.0;"
    Const ACDATASOURCE As String = "Data Source="

'追加
'CSVへ接続するためのConnectionを生成する
Public Function getCsvConnection(myDir As String, Optional hasHeader As Boolean = True) As ADODB.Connection
    Dim con As  ADODB.Connection
    Set con = New ADODB.Connection
    If hasHeader Then
        con.ConnectionString = Replace(CSVPROVIDER_HDRYES, "<SOURCE>", myDir)
    Else
        con.ConnectionString = Replace(CSVPROVIDER_HDRNO, "<SOURCE>", myDir)
    End If
    Set getCsvConnection = con
    Set con = Nothing
End Function

'accdb,mdb形式のAccessデータベースへ接続するためのConnectionを生成する
Public Function getAcConnection(myFilePath As String) As ADODB.Connection
    Dim con As  ADODB.Connection
    Set con = New ADODB.Connection
    con.ConnectionString = ACPROVIDER & ACDATASOURCE & myFilePath & ";"
    Set getAcConnection = con
    Set con = Nothing
End Function

簡単な解説

付け加えたのは、定数 CSVPROVIDER_HDRYES、CSVPROVIDER_HDRNOの二つ、メソッド(正確には関数ですが) getCsvConnectionです。

定数はCSVへ接続するための決まり文句になります。

なぜ二つあるかというと、CSV内の1行目をヘッダーとして認識するかどうか。

つまりヘッダーがあるかどうかの違いになります。

この違いは次のgetCsvConnectionの引数で指定して動きを変える仕様です。

getCsvConnectionは実際にCSVに接続するための関数です。

第一引数は対象のファイルがあるディレクトリを指定します。

Accessの場合は、Accessファイルを指定しますが、CSVの場合は、ディレクトリを指定します。

第二引数はヘッダ有無をboolean型で指定します。

ヘッダがあればtrue、なければfalseです。規定値はtrue(ヘッダあり)です。

ヘッダ無しを指定した場合、フィールド名は自動でF1、F2・・・と振られていきます。

ConnectionWrapper.clsはそのままですが再掲します。

 
'ConnectionWrapper.cls
Option Explicit
    '-------------------------------------------------------
    'ADODB.Connectionを使ってデータソースを扱うためのクラス。
    '各種手続きをラッピングする。
    '-------------------------------------------------------
    '参照設定
    'Microsoft ActiveX Data Object RecordSet
    'Microsoft ActiveX Data Object
    '---------------------------------------
    Private myConnection_ As New ADODB.Connection
    Private isOpen_ As Boolean

Public Sub setConnection(mycon As ADODB.Connection)
    Set myConnection_ = mycon
End Sub

'このメソッドを呼んだ場合、必ずcloseConnectionを呼び出す必要があります。
Public Sub openConnection()
    
    myConnection_.Open
    myConnection_.CursorLocation = 3 ' クライアントサイドカーソルに変更

    isOpen_ = True
End Sub

Function execute(sql As String) As ADODB.Recordset
    On Error GoTo catch
    
    Dim myCommand As Command: Set myCommand = New Command
    'CommandTextプロパティで実行可能なテキスト(例えばSQL)を定義する
    myCommand.CommandText = sql
    If isOpen_ = False Then
        openConnection
    End If
    Set myCommand.ActiveConnection = myConnection_
    Set execute = myCommand.execute
    
    Exit Function
catch:
    Me.closeConnection
    Err.Raise 1000, , "クエリ要求中にエラーが発生したため処理を中止します。" & vbNewLine & "---------" & vbNewLine & Err.Description & vbNewLine & "-----------"
End Function

Public Sub closeConnection()
    If Not (myConnection_ Is Nothing) Then
        If myConnection_.State <> 0 Then
            myConnection_.Close
            isOpen_ = False
        End If
    End If
End Sub

Public Function isOpen() As Boolean
    isOpen = isOpen_
End Function

Public Function beginTransaction() As Long
    If isOpen_ = False Then
        openConnection
    End If
    beginTransaction = myConnection_.BeginTrans
End Function

Public Sub commitTransaction()
    myConnection_.CommitTrans
End Sub

Public Sub rollback()
    myConnection_.RollbackTrans
End Sub

Private Sub Class_Terminate()
    closeConnection
End Sub

この2つのクラスを作成すれば前準備は完了です。

サンプル

CSVをExcelシートに書き出すサンプルです。

対象のCSV

C:\data.csv

id,name
1,ああ
2,いい

CSVファイルをシートに書き出してみます。

サンプルプロシージャ

 
Option Explicit

Sub readCSV()
    Dim cf As ConnectionFactory: Set cf = New ConnectionFactory
    Dim cw As ConnectionWrapper: Set cw = New ConnectionWrapper
        
    cw.setConnection cf.getCsvConnection(ThisWorkbook.Path)
    Dim rs As ADODB.Recordset: Set rs = cw.execute("select * from data.csv")
    Dim i As Long
    For i = 0 To rs.Fields.Count - 1
        Cells(i + 1, 1) = rs.Fields(i).Name
    Next i
    Cells(2, 1).CopyFromRecordset rs
End Sub

最初のコードより、可読性が高まったんじゃないですかね?

え、クラスモジュールまで追加して、逆に面倒だ?

そんなこと、ありませんよね?え?え・・・?

とにかくADODBを使うメリットはメインのプログラムの可読性アップだけではありません。

ADODBによるSQLを使うメリットは、SQLで自由にデータを加工できる点です。

デメリットは実行速度がちょっとだけ遅いことと、クラスモジュールが追加されること(この記事で紹介しているクラスを使う場合です。もちろんクラスモジュールを必ずしも使わなくてはいけないわけではありません)。

使いどころはケースバイケースですが、プログラムの可読性を高めることは重要だと思っています。

これも考え方次第ですけどね。

というわけで、ここまでお読み頂き、ありがとうございました。