Excel中如何通过VBA从SQL Server 2005数据库导入数据

现在许多应用都使用了数据库进行存储，如果我们需要使用Excel开发相关程序，就必须得面临一个如何导入数据的问题。像水文应用中什么水文历史数据库、水文实时数据库、水文水文预报数据库等 慢慢都采用SQL Server 2005作为后端数据库服务器，要在Excel中采集到相应的数据我们普通人员当然可以用Excel的导入数据进行操作，但难度还是比较复杂的(里面的数据表与字段实在太多)，因此可以让专业人员通过VBA从SQL Server 2005数据库导入数据，导出之后再加工即可，这里水文工具集给出一段示例代码，具体应用时按照需要进行修改。

'================================
' VBA从SQL Server 2005数据库导入数据示例
'
' 
'================================
Sub GetSQLServerDBData()
Dim dbConnectionnection As ADODB.Connection
Dim connStr As String

'Recordset variables
Dim rsData As ADODB.Recordset
Dim sql As String
connStr = "Provider=SQLOLEDB;" & _
          "Data Source=MyServer\MyInstance;" & _
          "Initial Catalog=MyDatabase;" & _
          "Integrated Security=SSPI;" & _
          "Application Name=MyExcelFile"

Set dbConnectionnection = New ADODB.Connection
dbConnectionnection.ConnectionString = connStr
dbConnectionnection.Open

Set rsData = New ADODB.Recordset
rsData.Open "SELECT field FROM table", dbConnectionnection
Dim field as String
Do While Not rsData.EOF
    'this is where each row will be processed
    field = rsData.Fields(0).Value
    'do what's needed with field
    rsData.MoveNext
Loop
Set rsData = Nothing
Set dbConnectionnection = Nothing
End Sub

引申：在家无法连接到SQL Server 2005数据库服务器时，我们可以把部分需要的数据数据转化为本地数据如Access，然后通过VBA访问Access数据库即可，这里也给出一段示例代码。

'================================
' VBA从Access数据库导入数据示例
'
' 
'================================
Sub GetAccessDBData()
    'Declare variables.
    Dim dbConnection As ADODB.Connection
    Dim rsData As ADODB.Recordset
    
    Dim sYourDB As String, sSQL As String
    Dim lNrRecords As Long
    Dim l As Long, l2 As Long
    Dim rTarget As Range
    
    sYourDB = "C:\path\to\app\AccessData.mdb"
    
    Set dbConnection = New ADODB.Connection
    dbConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & "Data Source=" & sYourDB & ";"
    Set rsData = New ADODB.Recordset
    
    ' Define your query (SQL here) - for example:
    sSQL = "select Lastname, Firstname, Telephone " & _
             "from Contacts " & _
             "where Lastname = 'Doe'"
    
    rsData.Open Source:=sSQL, ActiveConnection:=dbConnection, CursorType:=adOpenForwardOnly, LockType:=adLockReadOnly, Options:=adCmdText
    rsData.CursorLocation = adUseClient
    
    ' Determine the number of found records
    lNrRecords = rsData.RecordCount
 
   ' Write the data from the database and insert to the worksheet
    Set rTarget = ThisWorkbook.Worksheets(1).Range("A1")
    If Not rsData.EOF Then
        rsData.MoveFirst
        For l = 1 To rsData.RecordCount
            For l2 = 1 To rsData.Fields.Count - 1
                rTarget.Offset(l - 1, l2).Value = rsData.Fields(l2).Value
            Next l2
            rsData.MoveNext
        Next l
    End If
 
    ' Tidy up
    Set rsData = Nothing
    Set DB = Nothing
End Sub