Excel VBAからSQL Serverのデータを読み込む

sub Sample_DB ()

Dim CN1 As New ADODB.Connection
Dim strSQL As String
Dim RS1 As ADODB.Recordset

svr_name = "サーバー名"
DB_name = "ＤＢ名"
ID_name = "ログインＩＤ"
Pass = "パスワード"
Table_Name = "テーブル名"

Set CN1 = CreateObject("ADODB.Connection")
CN1.Open "Provider=Sqloledb;Data Source=" & svr_name & ";Initial Catalog=" & DB_name & ";user id=" & ID_name & ";password=" & Pass

strSQL = "SELECT * FROM テーブル名 ;"
Set RS1 = CN1.Execute(strSQL)

x = 1
Do Until RS1.EOF = True
　Cells(x, 2) = RS1.Fields!任意のフィールド名1
　Cells(x, 3) = RS1.Fields!任意のフィールド名2
　Cells(x, 4) = RS1.Fields!任意のフィールド名3
  Cells(x, 5) = RS1.Fields!任意のフィールド名4
  RS1.MoveNext
  x = x + 1
Loop

CN1.Close
Set CN1 = Nothing
Set RS1 = Nothing
MsgBox "正常に読込しました。"

End Sub

参照設定：Microsoft ActiveX Data Objects *.* Library