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ファイルを簡単に切り替える

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


コメント

アクセス数の多い投稿

セキュリティ対策ソフトのノートンが詐欺ソフトまがいになってしまってショック

突然滅茶苦茶遅くなったPCがWindows Updateのキャッシュクリアで復活

Teamsで日本語入力すると左上に変換ウィンドウが出る

Amazon Prime Videoで4K UHD映画を検索する方法

Excel 2019 クエリが原因で日本語入力の一文字目が勝手に確定する

iPhone 12 Proと iPhone 8 Plusのサイズを比較

Microsoft Flight Simulator (2020)のPS4コントローラー設定

次期主力Wi-Fiルーター NEC Aterm WX5400HP

Excel VBAからODBCを使ってデータを簡単に取得する

NEC Aterm WX5400HP をセットアップ