Excel VBA Queryを使って別のブックのシートをインポートするときのパターン

#インポートするときのファイルの用意

C:\hoge\ListFile.xlsxというファイル作りこんなリストを作ってみた
![image.png](https://qiita-image-store.s3.amazonaws.com/0/126919/7055296e-dca4-5873-39e5-e6acc8d70658.png)
##Sheet4に作成します
新しいファイルで実験してみてください。
一応Sheet4を作成するか、あればクリアします。
既存のデータがないか注意してください。

データベースになりうる形式のシートからデータを絞り込んでインポートできます。

#Excel2013ではExcelファイルをインポートするときは接続　ファイルから XMLファイルを選んですべてのファイルに変える
Excel2013でExcelファイルをExcelファイルにインポートする
データタブ
その他のデータソース
XMLデータインポート
ここでxmlファイル(*.xml)を
すべてのファイル(*.*)に変える
挿入したいExcelファイルを選択
##コード[Excel2013][Excel2016]
xmlから読み込むモードで記録して若干整理したものが以下のコード

```vb
Sub xlsxfileconnectwithxml()
'xml からすべてのファイルでxlsxを選んだ場合
'Excel 2013 And Excel 2016
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet
Dim xlQrys As Excel.Queries, xlQry
Dim bl As Boolean
Const xlQryName = "Sheet1"
Const ShtName = "Sheet4"
Const xlsxFile = "C:\hoge\Listfile.xlsx"
bl = False
For Each ws In wb.Worksheets
If ws.Name = "Sheet4" Then
ws.Activate
ws.UsedRange.Clear
bl = True
Exit For
End If
Next ws
If bl = False Then
Set ws = wb.Worksheets.Add(after:=wb.Worksheets.Count, Count:=1)
ws.Name = ShtName
End If
'普通は不要
For Each xlQry In wb.Queries
xlQry.DELETE
Next
'普通は不要///ここまで
Call qry_Remove_Hidden_Names
ws.Activate
    wb.Queries.Add Name:=xlQryName, Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    ソース = Excel.Workbook(File.Contents(" & Chr(34) & xlsxFile & Chr(34) & "), null, true)," & Chr(13) & "" & Chr(10) & "    Sheet1_Sheet = ソース{[Item=""Sheet1"",Kind=""Sheet""]}[Data]," & Chr(13) & "" & Chr(10) & "    昇格されたヘッダー数 = Table.PromoteHeaders(Sheet1_Sheet, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    変更された型 = Table.TransformColumnTypes(昇格されたヘッダー数,{{""No"", Int64.Type}, {""Fruits"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    変更された型"

    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=Sheet1;Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Sheet1] Where ([No] =1)")
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = xlQryName
        .Refresh BackgroundQuery:=False
    End With
End Sub
Private Sub qry_Remove_Hidden_Names()
' Dimension variables.
Dim xName As Excel.Name
Dim Result As Variant
Dim Vis As Variant
' Loop once for each name in the workbook.
For Each xName In ActiveWorkbook.Names
If xName.Visible = False Then
' ...ask whether or not to delete the name.
Result = MsgBox(prompt:="Delete  Name " & _
Chr(10) & xName.Name & "?" & Chr(10) & _
"Which refers to: " & Chr(10) & xName.RefersTo, _
Buttons:=vbYesNoCancel)
' If the result is true, then delete the name.
If Result = vbYes Then
xName.DELETE
ElseIf Result = vbCancel Then
Exit Sub
End If
End If
' Loop to the next name.
Next xName
End Sub

```
##出来上がりのイメージ
![image.png](https://qiita-image-store.s3.amazonaws.com/0/126919/b1f5a8cc-521a-326f-9c73-672a1c617cd7.png)



## 気づいた点
Excel2016で記録するとなぜか「変更された型」など日本語のコメントが入る
Call qry_Remove_Hidden_Namesはなくてもよい。実験で繰り返したとき名前が増えないようにしている。
またクエリ名も増えないようにしているが、
'普通は不要
For Each xlQry In wb.Queries
xlQry.DELETE
Next
'普通は不要///ここまで
の部分は普通は不要である。

###クエリの書式のFromはクエリ名
 .CommandText = Array("SELECT * FROM [Sheet1] Where ([No] =1)")
テーブル名、シート名ではないようだ。またWhereでNoフィールド名で絞り込みが可能。

#Excel2016 ではExcelファイルをインポートするときはデータ データの取得 ファイル ブックから
##コード[Excell2016]
これを記録して加工したものがこちら

```vb
Sub xlsxFileconnectwithfromBook()
'データの取得（接続）ファイルから >ブックからでxlsxを選んだ場合
'Excel 2016
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet
Dim xlQrys As Excel.Queries, xlQry
Dim bl As Boolean
Const xlQryName = "Sheet1 (2)"
Const ShtName = "Sheet4"
Const xlsxFile = "C:\hoge\Listfile.xlsx"
bl = False
'シート4を探し出しクリア、なければシートを作る
For Each ws In wb.Worksheets
If ws.Name = "Sheet4" Then
ws.Activate
ws.UsedRange.Clear
bl = True
Exit For
End If
Next ws
If bl = False Then
Set ws = wb.Worksheets.Add(after:=wb.Worksheets.Count, Count:=1)
ws.Name = ShtName
End If
'普通は不要
For Each xlQry In wb.Queries
xlQry.DELETE
Next
'普通は不要///ここまで
'これを単独でVBAのモジュールにコピーするときは、上記のコードの
'Private Sub qry_Remove_Hidden_Names()
'以下も一緒にコピーしてください。
Call qry_Remove_Hidden_Names
ws.Activate
    wb.Queries.Add Name:="Sheet1 (2)", Formula:= _
        "let" & Chr(13) & "" & Chr(10) & "    ソース = Excel.Workbook(File.Contents(" & Chr(34) & xlsxFile & Chr(34) & "), null, true)," & Chr(13) & "" & Chr(10) & "    Sheet1_Sheet = ソース{[Item=""Sheet1"",Kind=""Sheet""]}[Data]," & Chr(13) & "" & Chr(10) & "    昇格されたヘッダー数 = Table.PromoteHeaders(Sheet1_Sheet, [PromoteAllScalars=true])," & Chr(13) & "" & Chr(10) & "    変更された型 = Table.TransformColumnTypes(昇格されたヘッダー数,{{""No"", Int64.Type}, {""Fruits"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & "    変更された型"
   
    With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
        "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Sheet1 (2)"";Extended Properties=""""" _
        , Destination:=Range("$A$1")).QueryTable
        .CommandType = xlCmdSql
        .CommandText = Array("SELECT * FROM [Sheet1 (2)] Where ([Sheet1 (2)].[Fruits]='Banana')")
        'From のあとは[] 角かっこで囲んだクエリ名 そして [クエリ名]ピリオド[フィールド名]は可能 [クエリ名]びっくり[フィールド名]はエラーで不可
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Sheet1__2" 'Displayでは()かっこが使えないようだ
        .Refresh BackgroundQuery:=False
    End With
End Sub
```

##出来上がりのイメージ
![image.png](https://qiita-image-store.s3.amazonaws.com/0/126919/e24bac20-ac2f-6aee-1c5a-755b0244d6d1.png)

## 気づいた点

###フィールド名はピリオドは使えるが、びっくりはエラー
[Queryname].[Fieldname] ** Ok

[Queryname]![Fieldname] ** No


#参考
注: 最大で 1,048,576 行および 16,384 列をインポートおよびエクスポートできます。
[テキストファイルをインポートするにはWanichan](https://www.wanichan.com/pc/excel/2013/1/03.html)
[Excel(エクセル)上級講座：No.1 データのインポートとエクスポート](http://www.eurus.dti.ne.jp/~yoneyama/Excel/mous_jyo/jyo-1.html)
[テキスト ファイル (.txt または .csv) のインポートまたはエクスポート - support.office.com](https://support.office.com/ja-jp/article/%E3%83%86%E3%82%AD%E3%82%B9%E3%83%88-%E3%83%95%E3%82%A1%E3%82%A4%E3%83%AB-txt-%E3%81%BE%E3%81%9F%E3%81%AF-csv-%E3%81%AE%E3%82%A4%E3%83%B3%E3%83%9D%E3%83%BC%E3%83%88%E3%81%BE%E3%81%9F%E3%81%AF%E3%82%A8%E3%82%AF%E3%82%B9%E3%83%9D%E3%83%BC%E3%83%88-5250ac4c-663c-47ce-937b-339e391393ba)