SQLServer VBAでリモート接続

Option Explicit


'Microsoft OLE DB Provider for SQL Server→ADOでSQLServerにアクセスするためのプロバイダー。
Private Const PROVIDER As String = "SQLOLEDB"

Private Const DATA_SOURCE As String = "192.168.0.1"   'サーバ名
Private Const DATABASE As String = "TEST_DB"         'データベース名

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

Sub sample()
    On Error GoTo ERR_HANDLER
    Dim strSQL As String
    Dim i As Long

    '--------------------------------
    ' データベース接続
    '--------------------------------
    Dim cn As New ADODB.Connection

'    'Windows認証で接続する場合
'    cn.connectionString = "Provider=" & PROVIDER _
'                        & ";Data Source=" & DATA_SOURCE _
'                        & ";Initial Catalog=" & DATABASE _
'                        & ";Trusted_Connection=Yes"
'    cn.Open


   'SQL Server認証で接続する場合
   cn.connectionString = "Provider=" & PROVIDER _
                       & ";Data Source=" & DATA_SOURCE _
                       & ";Initial Catalog=" & DATABASE _
                       & ";user id=" & USER_ID _
                       & ";password=" & PASSWORD
   
   Debug.Print (cn.connectionString)
   cn.Open

    '--------------------------------
    ' SQLの実行
    '--------------------------------
    Dim rs As New ADODB.Recordset
    strSQL = "SELECT * FROM dbo.test;"
    rs.Open strSQL, cn

    '取得データをセルに一括出力
    rs.MoveFirst
    ActiveSheet.Range("A1").CopyFromRecordset rs
    'データベース切断
    Call disconnectDB(cn, rs)

Exit Sub

ERR_HANDLER:

    'エラーメッセージ
    Debug.Print Err.Number & ")" & Err.Description
    'データベース切断
    Call disconnectDB(cn, rs)
    
End Sub
Sub disconnectDB(cn As ADODB.Connection, rs As ADODB.Recordset)
    'データベース切断
    If Not rs Is Nothing Then
        If rs.State = adStateOpen Then rs.Close
        Set rs = Nothing
        End If
    If Not cn Is Nothing Then
        If cn.State = adStateOpen Then cn.Close
        Set cn = Nothing
    End If

End Sub