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