VBA: PowerQueryを使ってCSVファイルを読み込む パラメーター版

VBAでPower Queryを使ってCSVファイルを読み込む際の、パラメーターバージョンです。

Public Sub uImport()

    Dim uWB As Workbook
    Dim uWS As Worksheet
    Dim uFormula As String
    Dim uQuery As WorkbookQuery
    Dim uList As ListObject

    Const uCSVPath As String = "C:\NKTemp\Sample.csv"
    Const uType As String = "{""購入日"", type date}, {""金額"", Int64.Type}"
    Const uParamName As String = "uCsvPath"
    Const uQueryName As String = "任意のクエリー名"
    Const uListName As String = "任意のテーブル名"
    Const uSheet As String = "Sheet1"
    Const uDestination  As String = "A3"
    
    Set uWB = ThisWorkbook
    Set uWS = uWB.Worksheets(uSheet)  'テーブルを作成するワークシート
    
    uDeleteTableAndQuery uWS, uListName, uParamName, uQueryName
    
    uFormula = _
        """" & uCSVPath & """" & _
        " meta [IsParameterQuery=true, Type=""Any"", IsParameterQueryRequired=true]"
    
    Set uQuery = uWB.Queries.Add(Name:=uParamName, Formula:=uFormula)   'パラメーターを作成
    
    uFormula = _
        "let uSource = Csv.Document(File.Contents(" & uParamName & "), " & _
            "[Delimiter="","", Encoding=932, QuoteStyle=QuoteStyle.Csv]), " & _
        "uPromotedHeaders = Table.PromoteHeaders(uSource, [PromoteAllScalars=true]), " & _
        "uChangedType = Table.TransformColumnTypes(uPromotedHeaders, " & _
            "{" & uType & "}) " & _
        "in uChangedType"   ' M言語によるクエリー
    
    Set uQuery = uWB.Queries.Add(Name:=uQueryName, Formula:=uFormula)   'クエリーを作成
    
    Set uList = uWS.ListObjects.Add( _
        SourceType:=xlSrcExternal, _
        Source:="OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;" & _
            "Location=" & uQuery.Name, _
        Destination:=uWS.Range(uDestination)) 'テーブルを作成（クエリーテーブル付き）
    
    With uList.QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & uQuery.Name & "]")
        
        .ListObject.DisplayName = uListName
        
        .Refresh BackgroundQuery:=False '読込実行
    End With
End Sub

'指定されたーテーブルとクエリーを削除
Private Sub uDeleteTableAndQuery( _
    ByVal uWS As Worksheet, _
    ByVal uListName As String, _
    ByVal uParamName As String, _
    ByVal uQueryName As String)
    Dim uWB As Workbook
    Dim uQuery As WorkbookQuery
    Dim uList As ListObject
    
    For Each uList In uWS.ListObjects
        If uList.Name = uListName Then
            uList.Delete
            Exit For
        End If
    Next
    
    Set uWB = uWS.Parent
    
    For Each uQuery In uWB.Queries
        If uQuery.Name = uQueryName Or uQuery.Name = uParamName Then
            uQuery.Delete
        End If
    Next
End Sub

テーブルの内容をアップデートする際には、次のページの方法が使えるので、コードがシンプルになります。

VBA クエリーで読み込むCSVファイルを簡単に切り替える

一杯飲みながら書いているので動作は未確認です。