外部データのインポートマクロ

ImportExternalData.bas

Option Explicit

Sub 外部データのインポート()

    Dim ConnectionString As String
    Dim Query As String
    Dim ResultRange As Range

    ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=False;" + _
                        "Data Source=LocalHost\SQLEXPRESS;Initial Catalog=Test01"
    Query = "SELECT TOP 100 * FROM [sys].[objects] WHERE object_id > ?"

    'クエリの実行結果をアクティブセルにインポートする
    '※Array(10)はクエリパラメータ
    Set ResultRange = ImportDataUsingConnectionString(ActiveCell, ConnectionString, Query, Array(10))

    If Not ResultRange Is Nothing Then
        'インポートしたデータをテーブル化
        Call ResultRange.Parent.ListObjects.Add( _
            SourceType:=xlSrcRange, _
            Source:=ResultRange, _
            XlListObjectHasHeaders:=xlYes _
        )
    End If

End Sub

Function ImportDataUsingConnectionString( _
        Destination As Range, _
        ConnectionString As String, _
        Query As String, _
        Optional Parameters As Variant, _
        Optional HasHeader As Boolean = True _
    ) As Range

    Dim Connection As ADODB.Connection

    Set Connection = New ADODB.Connection
    With Connection
        .ConnectionString = ConnectionString

        Call .Open
        Set ImportDataUsingConnectionString = ImportDataUsingConnection(Destination, Connection, Query, Parameters, HasHeader)
        Call .Close
    End With

End Function

Function ImportDataUsingConnection( _
        Destination As Range, _
        Connection As ADODB.Connection, _
        Query As String, _
        Optional Parameters As Variant, _
        Optional HasHeader As Boolean = True _
    ) As Range

    Dim Command As ADODB.Command
    Dim Recordset As ADODB.Recordset

    Set Command = New ADODB.Command
    With Command
        Set .ActiveConnection = Connection
        .CommandType = adCmdText
        .CommandText = Query

        Set Recordset = .Execute(Parameters:=Parameters)
        Set ImportDataUsingConnection = ImportDataFromRecordset(Destination, Recordset, HasHeader)
        Call Recordset.Close
    End With

End Function

Function ImportDataFromRecordset( _
        Destination As Range, _
        Recordset As ADODB.Recordset, _
        Optional HasHeader As Boolean = True _
    ) As Range

    Dim QueryTable As QueryTable

    Set QueryTable = Destination.Cells(1).Parent.QueryTables.Add( _
                        Connection:=Recordset, Destination:=Destination.Cells(1))

    With QueryTable
        .FieldNames = HasHeader
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = False
        .RefreshPeriod = 0
        .PreserveColumnInfo = False

        Call .Refresh(False)
        Set ImportDataFromRecordset = .ResultRange
        Call .Delete
    End With

End Function