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
'############################################
'パワークエリ?ではないと思うけど、
'「データ→データの取得と変換グループ→テキストまたは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