VBA中用ADO连接SqlServer2005

按Alt+F11打开代码窗口，点击菜单上的"工具">>"引用"，勾选它:Microsoft ActiveX Data Objects 2.x

'================================
' 连接SqlServer2005

'================================

Private Sub ConnectDB()

Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset

Dim strCnn As String

Dim strHost As String
Dim strDatabaseName As String
Dim strUserName As String
Dim strPassword As String
Dim strSQL As String

Dim lCountOfFields As Long
Dim lrow As Long
Dim lcol As Long

'================================
' 定义连接字符串
'================================

strHost = "10.203.0.XX" 'Sqlsever服务器IP地址或计算机名
strDatabaseName = "master" '连接数据库名
strUserName = "sa" '登录用户名

strPassword = "123" '登录密码

On Error GoTo ConnectErr:

'================================
' 建立连接
'================================

strCnn = ""
strCnn = strCnn & "Provider=SQLOLEDB;"
strCnn = strCnn & "Password=" & strPassword & ";"
strCnn = strCnn & "User ID=" & strUserName & ";"
strCnn = strCnn & "Initial Catalog=" & strDatabaseName & ";"
strCnn = strCnn & "Data Source = " & strHost

Set cnn= New ADODB.Connection

With cnn

.ConnectionString = strCnn
.Open
End With

MsgBox "Connect successfully!", vbOKOnly + vbInformation

'================================
' 查询数据集
'================================

Set rs = New ADODB.Recordset
strSQL = "select * from spt_values "

rs.Open strSQL, cnn, adOpenForwardOnly, adLockReadOnly

'================================
' 将数据集填充到sheet
'================================

lrow = 2
lcol = 2

With Worksheets("Sheet1")
lCountOfFields = rs.Fields.Count
.Range(Cells(lrow, lcol).Address & ":" & Cells(lrow + 2, lcol + lCountOfFields - 1).Address).ClearContents
.Cells(lrow, lcol).CopyFromRecordset rs
End With

rs.Close

Exit Sub

ConnectErr:
MsgBox "Connect error!", vbOKOnly + vbCritical

End Sub

----------------------------------------------------------------------------------

'================================
' 断开连接

'================================

Public Sub CloseConnect()

On Error GoTo DisconnectErr:
cnn.Close
Set cnn = Nothing
MsgBox "Disconnect successfully!", vbOKOnly + vbInformation
Exit Sub

DisconnectErr:
MsgBox "Disconnect error!", vbOKOnly + vbCritical

End Sub