VBA SQL Serverに接続してtableのレコードを取得する

Option Explicit

Private Const PROVIDER As String = "SQLOLEDB"
Private Const DATA_SOURCE As String = "localhost"   'サーバ名
Private Const DATABASE As String = "sample" 'データベース名

'SQL Server認証で接続する場合
Private Const USER_ID As String = "sa"  'ユーザID
Private Const PASSWORD As String = "password"   'ユーザパスワード

Private Sub CommandButton1_Click()
    
    Dim strSQL As String
    Dim i As Long
    Dim adoCn As Object
    Dim adoRs As Object
    
    '--------------------------------
    ' データベース接続
    '--------------------------------
    Set adoCn = CreateObject("ADODB.Connection")
    
    
    'SQL Server認証
    adoCn.ConnectionString = "Provider=" & PROVIDER _
                       & ";Data Source=" & DATA_SOURCE _
                       & ";Initial Catalog=" & DATABASE _
                       & ";UID=" & USER_ID _
                       & ";PWD=" & PASSWORD
    adoCn.Open
    
    ' 実行するクエリ
    strSQL = "SELECT top(10) * FROM [sample].[dbo].[Test]"


    Set adoRs = CreateObject("ADODB.Recordset") 'ADOレコードセットオブジェクト
    
    adoRs.Open strSQL, adoCn 'レコード抽出
    
    Do Until adoRs.EOF 'レコードがなくなるまで
    
        i = i + 1
        Cells(i, 1).Value = adoRs!ID 'フィールド
        Cells(i, 2).Value = adoRs!Name 'フィールド
        adoRs.MoveNext '次のレコード
        
    Loop
    
    adoRs.Close: Set adoRs = Nothing '破棄
    
    '--------------------------------
    ' データベース切断
    '--------------------------------
    adoCn.Close: Set adoCn = Nothing

End Sub

Option Explicit

Private Const PROVIDER As String = "SQLOLEDB"
Private Const DATA_SOURCE As String = "localhost"   'サーバ名
Private Const DATABASE As String = "sample" 'データベース名

'SQL Server認証で接続する場合
Private Const USER_ID As String = "sa"  'ユーザID
Private Const PASSWORD As String = "password"   'ユーザパスワード

Private Sub CommandButton1_Click()

On Error GoTo EXCEPTION_SECTION

Const PROCEDURE_NAME As String = "CommandButton1_Click"
    
    Dim strSQL As String
    Dim i As Long
    Dim adoCn As Object
    Dim adoRs As Object
    
    '--------------------------------
    ' データベース接続
    '--------------------------------
    Set adoCn = CreateObject("ADODB.Connection")
    
    
    'SQL Server認証
    adoCn.ConnectionString = "Provider=" & PROVIDER _
                       & ";Data Source=" & DATA_SOURCE _
                       & ";Initial Catalog=" & DATABASE _
                       & ";UID=" & USER_ID _
                       & ";PWD=" & PASSWORD
    adoCn.Open
    
    ' 実行するクエリ
    strSQL = "SELECT top(10) * FROM [sample].[dbo].[Test]"

    Set adoRs = CreateObject("ADODB.Recordset") 'ADOレコードセットオブジェクト
    
    adoRs.Open strSQL, adoCn 'レコード抽出
    
    Do Until adoRs.EOF 'レコードがなくなるまで
    
        i = i + 1
        Cells(i, 1).Value = adoRs!ID 'フィールド
        Cells(i, 2).Value = adoRs!Name 'フィールド
        adoRs.MoveNext '次のレコード
        
    Loop  
    
    GoTo EXIT_SECTION

EXCEPTION_SECTION:

    With Err

        MsgBox (.Description), vbOKOnly + vbExclamation + vbSystemModal, PROCEDURE_NAME

    End With

    GoTo EXIT_SECTION

EXIT_SECTION:

    ' レコードセットのクローズ
    If Not adoRs Is Nothing Then
        If adoRs.State = 1 Then adoRs.Close ' 開かれていればクローズ
        Set adoRs = Nothing
    End If
    
    ' データベースのクローズ
    If Not adoCn Is Nothing Then
        If adoCn.State = 1 Then adoCn.Close ' 開かれていればクローズ
        Set adoCn = Nothing
    End If

End Sub