DB接続（ADO）

ADOは、データベースや CSV ファイルからエクセルにデータを持ってくる方法で、ActiveX データ オブジェクトの各単語の頭文字です。
Access や CSV のファイルから、SQL で指定してデータを抽出できます。
表形式のデータであればエクセルのシートのデータも扱えて、同じ Book であれば、複数の表形式のデータを結合して新しい表を作成することもできます。
（但し、１フィールド当たり256文字の文字制限などがあります）

Connection ストリングを整理して、レコードセットとしてデータを取得できるように関数を書きました。
ファイル名か SQL 文でデータソースを判別するようにしました。
取得したレコードセットは、GetRows で配列に読み込んだり、CopyFromRecordset でワークシートに張ったりできます。

サンプルコード

ヘッダーの指定の仕方が YES/NO の方が良いような気もするけど、取りあえずこんな感じ。

'========================================================================='
    Function GetRecordset( _
        ByVal pSQL As String, _
        ByVal pFullname As String, _
        Optional ByVal pHeader As Boolean _
    ) As Object
'========================================================================='
    
    Dim buff            As Variant
    Dim sPath           As String
    Dim sHDR            As String
    Dim sProvider       As String
    Dim sDataSource     As String
    Dim sExtProperties  As String
    Dim objConnection   As Object
    Dim objRecordSet    As Object
    Dim ErrMessage      As String
    Dim sConString      As String
    
    
    'ADO 定数(非参照設定)'
    Const adOpenStatic = 3
    Const adLockOptimistic = 3
    Const adCmdText = 1
    
    Set objConnection = CreateObject("ADODB.Connection")
    Set objRecordSet = CreateObject("ADODB.Recordset")
    
    '必須チェック'
    Select Case True
    Case InStr(pFullname, "SQLOLEDB") = 0
        '何もしない'
    Case pSQL = ""
        ErrMessage = "SQL文が空白です"
        GoTo RaiseError
    Case pFullname = ""
        ErrMessage = "ファイルのフルパスが空白です"
        GoTo RaiseError
    End Select
    
    'ファイル存在チェック'
    If Dir(pFullname) = "" Then
        ErrMessage = "ファイルが見つかりません"
        GoTo RaiseError
    End If
    
    '下準備'
    sHDR = IIf(pHeader, "HDR=YES", "HDR=NO")
    buff = Dir(pFullname)
    sPath = Replace(pFullname, buff, "")    'CSV用ファイルパス'
     
    'データソースの判定'
    Select Case True
    Case InStr(pSQL, ".csv") > 0, InStr(pSQL, ".txt") > 0
        sExtProperties = "Text; FMT=Delimited;" & sHDR
        sDataSource = sPath
    Case InStr(pFullname, "xls") > 0
        sExtProperties = "Excel 12.0; IMEX=1;" & sHDR
        sDataSource = pFullname
    Case InStr(pFullname, "accdb") > 0, InStr(pFullname, "mdb") > 0
        sDataSource = pFullname
    Case InStr(pFullname, "SQLOLEDB") > 0
        sDataSource = "SQLServer"
        sConString = pFullname
    Case Else
        ErrMessage = "データソースを判定できません"
        GoTo RaiseError
    End Select
    
    'DB オープン'
    If sDataSource <> "SQLServer" Then
        With objConnection
            .Provider = "Microsoft.ACE.OLEDB.12.0"
            .Properties("Extended Properties") = sExtProperties
            .Properties("Data Source") = sDataSource
            .Open
        End With
    Else
        objConnection.Open sConString
    End If
    
    'RecordSet オープン'
    objRecordSet.Open pSQL, objConnection, adOpenStatic, adLockOptimistic, adCmdText
    
    'リターン'
    Set GetRecordset = objRecordSet
    
    Exit Function
    
    RaiseError:
    Err.Raise 999, "Function getRecordset", ErrMessage
    
    End Function

使用方法サンプル

    Sub testCSV()
        Dim sSQL        As String
        Dim sFullname   As String
        Dim bHeader     As Boolean
        Dim rs          As Object

        sSQL = "SELECT * FROM Test.csv"
        sFullname = "C:\Users\user\Desktop\Test.csv"
        bHeader = True

        Set rs = GetRecordset(sSQL, sFullname, bHeader)

    End Sub
    
    Sub testExcel()
        Dim sSQL        As String
        Dim sFullname   As String
        Dim bHeader     As Boolean
        Dim rs          As Object

        sSQL = "SELECT * FROM [表紙$B3:G7]"
        sFullname = "C:\Users\user\Desktop\Test.xlsm"
        bHeader = True

        Set rs = GetRecordset(sSQL, sFullname, bHeader)

    End Sub
    
    Sub testAccess()
        Dim sSQL        As String
        Dim sFullname   As String
        Dim rs          As Object

        sSQL = "SELECT * FROM Table1"
        sFullname = "C:\Users\user\Desktop\Database1.accdb"

        Set rs = GetRecordset(sSQL, sFullname)

    End Sub

    Sub testSQLServer()
        Dim sSQL        As String
        Dim sCnString   As String
        Dim rs          As Object

        sSQL = "SELECT * FROM Table1"
        sCnString = "PROVIDER=SQLOLEDB;DATA SOURCE=SQLSERVER-01;UID=UserID;PWD=PassWord;DATABASE=USER_DB"

        Set rs = GetRecordset(sSQL, sCnString)

    End Sub