http://mukaer.com/archives/2010/10/17/excelsqlvlookup/
http://yizndev.blogspot.jp/2015/01/excel-sql.html
https://qiita.com/acknpop/items/cd4a6fe32bf6af409aa3
Const oRow = 2 'OutPutCellRow
Const oColumn = 1 'OutPutCellColumn
Const SQLCell = "B1"
Sub ESQL()
Dim sql
Dim str
'SQL(B1セル)
sql = Range(SQLCell).Value
'ツール → 参照設定 →
' Microsoft ActiveX Data Objects 2.8 Library
'チェック
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim xl_file As String
xl_file = ThisWorkbook.FullName '他のブックを指定しても良し
Set cn = New ADODB.Connection
cn.Provider = "MSDASQL"
cn.ConnectionString _
= "Driver={Microsoft Excel Driver (*.xls)};" _
& "DBQ=" & xl_file & "; ReadOnly=False;"
cn.Open
Set rs = New ADODB.Recordset
rs.Open sql, cn, adOpenStatic
'フィールドNAME表示
For i = 0 To rs.Fields.Count - 1
Cells(oRow, i + 1).Value = rs(i).Name
Next
'カラム表示
j = oRow + 1
Do Until rs.EOF
'1 レコード毎の処理
For i = 0 To rs.Fields.Count - 1
Cells(j, i + 1).Value = rs(i).Value
Next
j = j + 1
rs.MoveNext
Loop
rs.Close
cn.Close
End Sub
Sub ClearCells()
Dim lRow 'LastCellRow
Dim lColumn 'LastCellColumn
lRow = Cells(oRow, oColumn).End(xlDown).Row
lColumn = Cells(oRow, oColumn).End(xlToRight).Column
'文字クリア
ActiveSheet.Range(Cells(oRow, oColumn), Cells(lRow, lColumn)).ClearContents
End Sub