【PowerQueryを活用】VBAでCSVファイルを取り込む最適な方法

今回は久しぶりにExcel VBAに関するトピックを取り上げていきたいと思います。

取り上げるのは、VBAでCSVファイルを、PowerQueryを使って取り込む方法です。

まずは手動で取り込む方法を見ていきたいと思います。

ExcelにCSVファイルをインポート何らかの形で活用することはあると思いますが、少しコツが必要です。

例えばこのようなCSVファイル。

メモ欄の一部が改行されている状態になっています。

このファイルをExcelに取り込んでみると、

改行されたメモがうまく取り込まれておらず、商品名欄にずれ込んでいるのがわかると思います。

これをうまく取り込むために、Power Queryを活用する必要があります。

Power QueryをVBAで活用
まとめ

Power QueryをVBAで活用

タブの【新しいクエリ】→【ファイルから】→【CSVから】を順にクリックしていきます。

ファイルオープンダイアローグが表示されるので、該当のCSVファイルを選択してインポートをクリックします。

下のように表示されるので、【読み込み】ボタンをクリックします。

しばらくすると、下のように表示されます。

先ほどズレが生じて違う行に入り込んでいたメモの部分が、メモ欄の中で改行されて正しく表示されています。

手作業でまずは行いましたが、手作業でこれを毎回行うのはやはりめんどくさいですよね。

そこでマクロやVBAを用いて自動化する必要がでてきます。

ここまでの操作をVBAを使用して作成する前に、まずはマクロを利用してコードを見ていきたいと思います。

マクロを使用して生成されたコードがこちらになります。

結構複雑なコードになっていますね。

これを一からVBAで書くのはかなり億劫に感じるのではないでしょうか。

よってマクロでまずコードを生成してから、コードをアレンジする方法がベストかと思います。

アレンジするといっても大掛かりなものではなく、一部を変更するだけでOKです。

生成したマクロコードの変更する部分に赤い囲みをつけてみました。

サンプル2、サンプル(2)、サンプル__2は、もともとのCSVファイル名の【サンプル.csv】から拡張子(.csv)を取り除いたものになります。

パスが”C:\Users\Desktop\サンプル.csv”となっていますが、

これらの赤い囲みのサンプル表記の部分とパスを変数に置き換えれば、他のファイルやパスが変わっても活用することができます。

また赤い囲みの部分で、サンプル2、サンプル(2)、サンプル__2となっている部分は、基本的にはサンプル.csvと同一のものなので、

変数に置き換える時は同じ変数を置けば大丈夫です。

以下が完成コードです。

Sub Macro2()

    
    Dim GetFilePath As String
    Dim lFindPoint As Long
    Dim GetOnlyFileName As String
    Dim GetRemoveExtensionFileName  As String
    Dim qtCsv   As QueryTable
     
    'ブックのクエリを全削除
    Dim qry As WorkbookQuery
    For Each qry In wb.Queries
        qry.Delete
    Next
    
    '絶対パスでファイルオープンウィンドウを開いてファイル取得(C:\Users\Desktop\サンプル.csv)
    GetFilePath = Application.GetOpenFilename("CSVファイル,*.csv?")

    'ファイルを指定しない場合、ファイルオープンウィンドウを閉じる
    If GetFilePath = "False" Then Exit Sub
   
    '絶対パスからファイル名のみを取得(サンプル.csv)
    GetOnlyFileName = Mid(GetFilePath, InStrRev(GetFilePath, "\") + 1)
   
    'ファイル名の拡張子の位置を検索
    lFindPoint = InStrRev(GetOnlyFileName, ".")
    
    'ファイル名から拡張子を除く(サンプル)
    GetRemoveExtensionFileName = Left(GetOnlyFileName, lFindPoint - 1)


    ActiveWorkbook.Queries.Add Name:="GetRemoveExtensionFileName", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    ソース = Csv.Document(File.Contents(""" & GetFilePath & """),[Delimiter="","", Columns=10, Encoding=932, QuoteStyle=QuoteStyle.Csv])," & Chr(13) & "" & Chr(10) & "    昇格されたヘッダー数 = Table.PromoteHeaders(ソース, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    変更された型 = Table.TransformColumnTypes(昇格されたヘッダー数,{{""商品名"", type text}, {""値段"", type text}, {""個数"", Int64.Type}, {""委託先"", type text}, {""販" & _
        "売先"", type text}, {""産地"", type text}, {""生産者"", type text}, {""個数_1"", Int64.Type}, {""注文者"", type text}, {""メモ"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    変更された型" & _
        ""
    Sheets.Add After:=ActiveSheet
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""GetRemoveExtensionFileName"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [GetRemoveExtensionFileName]")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = False
        .ListObject.DisplayName = "GetRemoveExtensionFileName"
        .Refresh BackgroundQuery:=False
    End With
    Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
End Sub

Sub Macro2()

Dim GetFilePath As String

Dim lFindPoint As Long

Dim GetOnlyFileName As String

Dim GetRemoveExtensionFileName As String

Dim qtCsv As QueryTable

'ブックのクエリを全削除

Dim qry As WorkbookQuery

For Each qry In wb.Queries

qry.Delete

'絶対パスでファイルオープンウィンドウを開いてファイル取得(C:\Users\Desktop\サンプル.csv)

GetFilePath = Application.GetOpenFilename("CSVファイル,*.csv?")

'ファイルを指定しない場合、ファイルオープンウィンドウを閉じる

If GetFilePath = "False" Then Exit Sub

'絶対パスからファイル名のみを取得(サンプル.csv)

GetOnlyFileName = Mid(GetFilePath, InStrRev(GetFilePath, "\") + 1)

'ファイル名の拡張子の位置を検索

lFindPoint = InStrRev(GetOnlyFileName, ".")

'ファイル名から拡張子を除く(サンプル)

GetRemoveExtensionFileName = Left(GetOnlyFileName, lFindPoint - 1)

ActiveWorkbook.Queries.Add Name:="GetRemoveExtensionFileName", Formula:= _

"let" & Chr(13) & "" & Chr(10) & " ソース = Csv.Document(File.Contents(""" & GetFilePath & """),[Delimiter="","", Columns=10, Encoding=932, QuoteStyle=QuoteStyle.Csv])," & Chr(13) & "" & Chr(10) & " 昇格されたヘッダー数 = Table.PromoteHeaders(ソース, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & " 変更された型 = Table.TransformColumnTypes(昇格されたヘッダー数,{{""商品名"", type text}, {""値段"", type text}, {""個数"", Int64.Type}, {""委託先"", type text}, {""販" & _

"売先"", type text}, {""産地"", type text}, {""生産者"", type text}, {""個数_1"", Int64.Type}, {""注文者"", type text}, {""メモ"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " 変更された型" & _

Sheets.Add After:=ActiveSheet

With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _

"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""GetRemoveExtensionFileName"";Extended Properties=""""" _

, Destination:=Range("$A$1")).QueryTable

.CommandType = xlCmdSql

.CommandText = Array("SELECT * FROM [GetRemoveExtensionFileName]")

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.RefreshOnFileOpen = False

.BackgroundQuery = True

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.PreserveColumnInfo = False

.ListObject.DisplayName = "GetRemoveExtensionFileName"

.Refresh BackgroundQuery:=False

End With

Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False

End Sub

変更したのは赤い囲みの部分だけなので、そこまで手間はかかりません。

コードの説明を少ししていきたいと思います。

'絶対パスでファイルオープンウィンドウを開いてファイル取得(C:\Users\Desktop\サンプル.csv) 
GetFilePath = Application.GetOpenFilename("CSVファイル,*.csv?")

1 2	'絶対パスでファイルオープンウィンドウを開いてファイル取得(C:\Users\Desktop\サンプル.csv) GetFilePath = Application.GetOpenFilename("CSVファイル,*.csv?")

Application.GetOpenFilename(“CSVファイル,*.csv?”)でファイルオープンダイアローグを開いて、csvファイルを選択できるようにします。

上記のファイルオープンダイアローグの場合、サンプル.csvを選択すると、GetFilePathに

絶対パス(“C:\Users\Desktop\サンプル.csv”)が格納されます。

'絶対パスからファイル名のみを取得(結果→サンプル.csv) 
GetOnlyFileName = Mid(GetFilePath, InStrRev(GetFilePath, "\") + 1) 

'ファイル名の拡張子の位置を検索 
lFindPoint = InStrRev(GetOnlyFileName, ".") 

'ファイル名から拡張子を除く(結果→サンプル) 
GetRemoveExtensionFileName = Left(GetOnlyFileName, lFindPoint - 1)

'絶対パスからファイル名のみを取得(結果→サンプル.csv)

GetOnlyFileName = Mid(GetFilePath, InStrRev(GetFilePath, "\") + 1)

'ファイル名の拡張子の位置を検索

lFindPoint = InStrRev(GetOnlyFileName, ".")

'ファイル名から拡張子を除く(結果→サンプル)

GetRemoveExtensionFileName = Left(GetOnlyFileName, lFindPoint - 1)

ここまでの処理で、最終的にGetRemoveExtensionFileName =”サンプル”

が格納される形となります。

コードを書く上で、注意する点をいくつか取り上げていきます。

ActiveWorkbook.Queries.Add Name:="GetRemoveExtensionFileName"

ソース = Csv.Document(File.Contents(""" & GetFilePath & """)

Source=$Workbook$;Location=""GetRemoveExtensionFileName""

.CommandText = Array("SELECT * FROM [GetRemoveExtensionFileName]")

.ListObject.DisplayName = "GetRemoveExtensionFileName"

ActiveWorkbook.Queries.Add Name:="GetRemoveExtensionFileName"

ソース = Csv.Document(File.Contents(""" & GetFilePath & """)

Source=$Workbook$;Location=""GetRemoveExtensionFileName""

.CommandText = Array("SELECT * FROM [GetRemoveExtensionFileName]")

.ListObject.DisplayName = "GetRemoveExtensionFileName"

上記のの5つの部分で、定義した変数名GetRemoveExtensionFileNameやGetFilePathを、

“”(ダブルクォーテーション)で囲んでいる点です。

変数名をこのような形でダブルクォーテーションで括るのは何か違和感があるかもしれませんが、

括らないとエラーが発生するので注意が必要です。

特にFile.Contents(“”” & GetFilePath & “””)の部分は、特殊な形なので、

(“”” & G変数名 & “””)になることを忘れないようにする必要があります。

まとめ

今回はPower Queryを活用してVBAでCSVファイルを取り込む方法について取り上げてきました。

今回紹介したように、Power Queryの処理をVBAで一から書くよりもマクロと併用しながら書いていく方が能率が良いと思います。

Power Queryについてまだまだ情報は多くなく、使いこなすのは難しく感じるかもしれませんが、

とても便利なツールなので、またこちらでも情報を得て紹介していきたいと思います。