2023年8月22日火曜日

XXXXXX

 Option Explicit
'############################################
'パワークエリ?ではないと思うけど、
'「データ→データの取得と変換グループ→テキストまたはCSVから」ボタン
'でのCSVの吸込み
'############################################
Sub Main()
    Call PwQueryDelete
    Call CSVImport01
End Sub

Function CSVImport01()
    Dim o_QTItem        As QueryTable
    Dim sInFNameFull    As String
    Dim sTgtTblName     As String
    
    sInFNameFull = ActiveWorkbook.Path & "\" & "1.csv"
    sTgtTblName = "1 (2)"
    
    Call ActiveWorkbook.Queries.Add _
            ( _
             Name:="" & sTgtTblName & "", _
             Formula:= _
                 "let" & _
                 Chr(13) & "" & Chr(10) & "    ソース = Csv.Document(File.Contents(" & """" & sInFNameFull & """" & "),[Delimiter="","", Columns=2, Encoding=932, QuoteStyle=QuoteStyle.None])," & _
                 Chr(13) & "" & Chr(10) & "    昇格されたヘッダー数 = Table.PromoteHeaders(ソース, [PromoteAllScalars=true])," & _
                 Chr(13) & "" & Chr(10) & "    変更された型 = Table.TransformColumnTypes(昇格されたヘッダー数,{{""a"", Int64.Type}, {""b"", Int64.Type}})" & _
                 Chr(13) & "" & Chr(10) & _
                 "in" & _
                 Chr(13) & "" & Chr(10) & "    変更された型" _
            )
    
    Set o_QTItem = ActiveSheet.ListObjects.Add( _
                      SourceType:=0, _
                      Source:="OLEDB" & _
                      ";Provider=Microsoft.Mashup.OleDb.1" & _
                      ";Data Source=$Workbook$" & _
                      ";Location=""" & sTgtTblName & """" & _
                      ";Extended Properties=""""", _
                      Destination:=Range("$A$1")).QueryTable
    
    'クエリの内容表示
    With o_QTItem
      
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & sTgtTblName & "]") '前段階で定義した[1 (2)]をテーブルとして使う。
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "_1__2"
        .Refresh BackgroundQuery:=False    'この時点で、クエリ内容が表示されます。
    End With
    
    o_QTItem.ListObject.TableStyle = ""
    
End Function

Function bkCSVImport01()
    Dim o_QTItem        As QueryTable
    Dim sInFNameFull    As String
    Dim sTgtTblName     As String
    
    sInFNameFull = ActiveWorkbook.Path & "\" & "1.csv"
    sTgtTblName = "1 (2)"
    
    Call ActiveWorkbook.Queries.Add _
            ( _
             Name:="1 (2)", _
             Formula:= _
                 "let" & _
                 Chr(13) & "" & Chr(10) & "    ソース = Csv.Document(File.Contents(" & """" & sInFNameFull & """" & "),[Delimiter="","", Columns=2, Encoding=932, QuoteStyle=QuoteStyle.None])," & _
                 Chr(13) & "" & Chr(10) & "    昇格されたヘッダー数 = Table.PromoteHeaders(ソース, [PromoteAllScalars=true])," & _
                 Chr(13) & "" & Chr(10) & "    変更された型 = Table.TransformColumnTypes(昇格されたヘッダー数,{{""a"", Int64.Type}, {""b"", Int64.Type}})" & _
                 Chr(13) & "" & Chr(10) & _
                 "in" & _
                 Chr(13) & "" & Chr(10) & "    変更された型" _
            )
    
    Set o_QTItem = ActiveSheet.ListObjects.Add( _
                      SourceType:=0, _
                      Source:="OLEDB" & _
                      ";Provider=Microsoft.Mashup.OleDb.1" & _
                      ";Data Source=$Workbook$" & _
                      ";Location=""" & sTgtTblName & """" & _
                      ";Extended Properties=""""", _
                      Destination:=Range("$A$1")).QueryTable
    
    'クエリの内容表示
    With o_QTItem
      
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [" & sTgtTblName & "]") '前段階で定義した[1 (2)]をテーブルとして使う。
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "_1__2"
        .Refresh BackgroundQuery:=False    'この時点で、クエリ内容が表示されます。
    End With
    
    
End Function

'############################################
'パワークエリの削除
'############################################
Function PwQueryDelete()
    Dim o_Qryitem01 As WorkbookQuery
        
    For Each o_Qryitem01 In ActiveWorkbook.Queries
        Call o_Qryitem01.Delete
    Next o_Qryitem01
 
    Call ActiveWorkbook.ActiveSheet.Rows.Delete
    
End Function