Call: xxxxxxxxx | Email: info@example.com

Excel SQL


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

Have any Question or Comment?

コメントを残す

メールアドレスが公開されることはありません。 * が付いている欄は必須項目です

最近のコメント

    アーカイブ