Excel VBA Power Query クエリ作成汎用ツール

let
    ソース = Folder.Files("D:\Users\Desktop\CSV"),
    ファイル変換 = Table.AddColumn(ソース, "CSV変換", each Table.PromoteHeaders(Csv.Document([Content],[Delimiter=",",
        Encoding=932, QuoteStyle=QuoteStyle.None]))),
    不要な列を削除 = Table.RemoveColumns(ファイル変換,{"Content", "Extension", "Date accessed", "Date modified", "Date created", "Attributes", "Folder Path"}),
    名前が変更された列 = Table.RenameColumns(不要な列を削除,{{"Name", "FileName"}})
in
    名前が変更された列

let
    ソース = Folder.Files("D:\Users\Desktop\エクセル"),
    ファイル変換 = Table.AddColumn(ソース, "XLS変換", each Excel.Workbook([Content],true){[Item="Sheet1",Kind="Sheet"]}[Data]),
    不要な列を削除 = Table.RemoveColumns(ファイル変換,{"Content", "Extension", "Date accessed", "Date modified", "Date created", "Attributes", "Folder Path"}),
    #"名前が変更された列 " = Table.RenameColumns(不要な列を削除,{{"Name", "Source.Name"}})
in
    #"名前が変更された列 "

let
    ソース = Csv.Document(File.Contents("D:\Users\Desktop\CSV\20210601.csv"),[Delimiter=",", Columns=6, Encoding=932, QuoteStyle=QuoteStyle.None]),
    昇格されたヘッダー数 = Table.PromoteHeaders(ソース, [PromoteAllScalars=true]),
    変更された型 = Table.TransformColumnTypes(昇格されたヘッダー数,{{"販売日", type date}, {"エリア", type text}, {"品名", type text}, {"数量", Int64.Type}, {"金額", Int64.Type}, {"店舗コード", type text}})
in
    変更された型

let
    ソース = Excel.Workbook(File.Contents("D:\Users\Desktop\エクセル\20210602.xlsx"), null, true),
    Sheet1_Sheet = ソース{[Item="Sheet1",Kind="Sheet"]}[Data],
    昇格されたヘッダー数 = Table.PromoteHeaders(Sheet1_Sheet, [PromoteAllScalars=true]),
    変更された型 = Table.TransformColumnTypes(昇格されたヘッダー数,{{"販売日", type date}, {"エリア", type text}, {"品名", type text}, {"数量", Int64.Type}, {"金額", Int64.Type}, {"店舗コード", type text}})
in
    変更された型

'VBAでクエリを作成するサンプル（フォルダー＆ファイル）
'フォルダーからはサンプルクエリなしで取得します
Sub AddQueryGetData()
    Dim qname As String         'クエリ名用
    'クエリ名はインプットボックスで入力指定を可能にする
    qname = Application.InputBox( _
        "作成するクエリ名前を入力または選択してください！", "クエリ名設定", "Sample")
    If qname = "False" Then Exit Sub        '指定のない場合中止
    
    Dim sourcePath As String    'ソース指定用
    'Sourceを選択指定させる
    sourcePath = Application.InputBox( _
        "ソースパスとする「Name」セル選択してください！", "ソースパス名指定", "")
    If sourcePath = "False" Then Exit Sub   '指定のない場合中止
    
    'ソースパスのRangeを取得
    Dim rng As Range
    Set rng = Range("A:A").Find(sourcePath)
    If rng Is Nothing Then MsgBox "設定がみつかりませんでした。": Exit Sub
    sourcePath = Chr(34) & sourcePath & Chr(34) 'ソースパスに""付加
    
    'ソースが絶対パスかどうかを確認して処理を分岐する
    Dim fso As Object   'FileSystemObjectを使う
    Dim sPath As String, sExt As String
    Dim sItem As String, sKind As String
    Set fso = CreateObject("Scripting.FileSystemObject")
    sPath = rng.Offset(0, 1).Value  'ソースのパス指定
    sExt = rng.Offset(0, 2).Value   'ソースの拡張子の指定
    sItem = rng.Offset(0, 3).Value  '対象名(Sheet名,Table名 ?)
    If sItem = "" Then sItem = "Sheet1" '指定がない場合"Sheet1"
    sKind = rng.Offset(0, 4).Value  '対象の種類(Sheet,Table ?)
    If sKind = "" Then sKind = "Sheet"  '指定がない場合"Sheet"
    
    'FileSystemObjectを使ってパス指定を検証
    If sPath = fso.GetAbsolutePathName(sPath) Then
        '絶対パスの場合の処理
        sPath = "GetParamValue(" & sourcePath & ")"
    Else
        '相対パスなら
        sPath = "GetParamValue(""MyPath"") & GetParamValue(" & sourcePath & ")"
    End If
    Set fso = Nothing
    
    'フォルダ/ファイルの指定判定
    Select Case sExt
        Case "csv"
            'フォルダ内csvの場合のMコード
            sExt = "ソース, ""CSV変換"", " & _
                "each Table.PromoteHeaders(Csv.Document([Content],[Delimiter="",""," & _
                "Encoding=932, QuoteStyle=QuoteStyle.None]))),"
        Case "xls"
            'フォルダ内ブックの場合のMコード
            sExt = "ソース, ""XLS変換"", " & _
                "each Excel.Workbook([Content],true){[Item=""" _
                & sItem & """,Kind=""" & sKind & """]}[Data]),"
        Case "CSVファイル"
            'csv単一ファイルの場合のMコードをセット
            ActiveWorkbook.Queries.Add Name:=qname, Formula:= _
            "let" & Chr(13) & Chr(10) & _
            "    ソース = Csv.Document(File.Contents(" & sPath & "),[Delimiter="","", Columns=18, Encoding=932, QuoteStyle=QuoteStyle.None])," & Chr(13) & _
            "    昇格されたヘッダー数 = Table.PromoteHeaders(ソース, [PromoteAllScalars=true])" & Chr(13) & _
            "in" & Chr(13) & Chr(10) & _
            "    昇格されたヘッダー数 //ソース//変更された型"
            MsgBox "csvファイルのクエリを作成しました！": Exit Sub
        Case "Excelブック"
            'エクセル単一ファイルの場合のMコードをセット
            ActiveWorkbook.Queries.Add Name:=qname, Formula:= _
            "let" & Chr(13) & Chr(10) & _
            "    ソース = Excel.Workbook(File.Contents(" & sPath & "))," & Chr(13) & _
            "    " & sItem & "_" & sKind & " = ソース{[Item=""" & sItem & """,Kind=""" & sKind & """]}[Data]" & Chr(13) & _
            "//    昇格されたヘッダー数 = Table.PromoteHeaders(" & sItem & "_" & sKind & ", [PromoteAllScalars=true])" & Chr(13) & _
            "in" & Chr(13) & Chr(10) & _
            "    " & sItem & "_" & sKind & ""
            MsgBox "Excelブックのクエリを作成しました！": Exit Sub
        Case Else
            MsgBox "ファイル指定が不明のため中止します！": Exit Sub
    End Select
    'ここからはフォルダー指定の場合の処理
    'パラメーターによりフォルダ内ファイルを展開できるカスタム列作成までのMコードをセット
    ActiveWorkbook.Queries.Add Name:=qname, Formula:= _
    "let" & Chr(13) & Chr(10) & _
    "    ソース = Folder.Files(" & sPath & ")," & Chr(13) & _
    "    ファイル変換 = Table.AddColumn(" & sExt & Chr(13) & _
    "    不要な列を削除 = Table.RemoveColumns(ファイル変換,{""Content"", ""Extension"", ""Date accessed"", " & _
                            """Date modified"", ""Date created"", ""Attributes"", ""Folder Path""})," & Chr(13) & _
    "    名前が変更された列 = Table.RenameColumns(不要な列を削除,{{""Name"", ""FileName""}})" & Chr(13) & _
    "in" & Chr(13) & Chr(10) & _
    "    名前が変更された列"
    MsgBox sourcePath & "のクエリ作成処理を完了しました！": Exit Sub
End Sub