這些代碼有如下優勢：
無需任何配置。在VBA中新建模塊，並把代碼復制轉帖過去即可使用。 有以下函數：執行數據庫語句、查詢數據庫、結果復制到單元格（Excel中最常用）、將Excel表格上傳到數據庫。基本覆蓋Excel中對數據庫的常用操作。 會在立即窗口顯示數據庫錯誤信息，方便查錯。 在數據庫連接字符串字典中配好數據庫連接信息後，數據庫訪問時可直接使用配好的鏈接字符串。具體的函數用法已經寫在下面代碼註釋裏。簡單描述壹下：
dqQueryToArray(sql, connection_string) 查詢數據庫，返回壹個二維數組 dbQueryOne(sql, connection_string) 查詢數據庫，返回單個變量。 dbQueryToCell(sql, range, connection_string, withHeader) 查詢數據庫後，將結果顯示在range開始的區域中；withHeader控制是否顯示列名。 dbExec(sql, necction_string) 執行數據庫語句；無返回值 dbInsertRange(table, range, connection_string, is_empty) 將本Excel文件的range區域裏的數據插入到數據庫的表table。其中is_empty控制在上傳數據前是否清空table的原數據。其它就看壹下代碼吧：
' EXCEL的ADO數據庫操作函數庫
' 這些代碼應該放在Excel的VBA模塊中，類模塊的名字為database，並以以下形式引用：
'
' res = dbQueryToArry(sql, connection_string)
' ' 返回sql的查詢結果，結果為壹個二維數組
' res = dbQueryOne(sql, connection_string)
' ' 返回sql的查詢結果，但只返回第壹個數據(相當於數據庫查詢結果的左上角那個數據)
' dbQueryToCell sql, save_to_range, connection_string, withHeader
' ' 將sql的查詢結果直接寫入到以save_to_range開頭的單元格區域中
' ' withHeader控制是否復制表頭，默認為true（復制表頭）
'
' 其中參數sql為數據庫查詢語句，connection_string為數據庫連接字符串。
'
' 比如要連接SQL數據庫，並已經設置ODBC，連接字符串為：
' "Provider=MSDASQL;DSN=odbc_name;UID=username;PWD=password;database=database_name;"
' 如果未設置ODBC，連接字符串為：
' "driver={SQL Server};server=service_name_or_ip;uid=username;pwd=password;database=database_name;"
' 其中最後面的database變量可省略。對於SQL Server，推薦使用後壹種方法。
'
' 如果數據來源為Excel文件，connection_string參數可省略
'
' 其它功能：內置數據庫的連接字符串、查詢存儲過程
'
' Author: zhang@zhiqiang.org, 2014-03-01 v4
' url: n As Object, rst As Object, lastConn As String
Private Sub dbInitialize()
If Not sqlDict Is Nothing Then Exit Sub
Set sqlDict = CreateObject("scripting.Dictionary")
lastConn = ""
' 在這裏可以緩存壹些常用的數據庫信息，這樣在查詢數據庫時可以直接調用
' 比如dbQueryToArry(sql, "this")
With sqlDict
.Add "SQL服務器", _
"Provider=MSDASQL;DSN=odbc_name;UID=username;PWD=password;database=database_name;"
.Add "SQL服務器(無需配置ODBC)", _
"driver={SQL Server};server=ip;uid=username;pwd=password;database=database_name;"
.Add "this", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & _
";Extended Properties=Excel " & Application.Version & ";"
End With
End Sub
' 查詢數據庫，返回RecordSet對象
' sql: 數據庫查詢語句
' sqlConnectString: 數據庫連接信息，或者直接指定數據庫，比如"Wind"、"JYDB"等，
' 利用內設的數據庫連接信息
Public Function dbQuery(sql As String, _
Optional ByVal sqlConnectString As String = "this") As Object ' ADODB.Recordset
dbConnectSQL sqlConnectString
On Error GoTo errorhander
rst.Open sql, cnn
Set dbQuery = rst
errorhander:
dbDisplayError sql
End Function
' 查詢數據庫，返回壹個數組
' sql: 數據庫查詢語句
' sqlConnectString: 數據庫連接信息，或者直接指定數據庫，比如"Wind"、"JYDB"等，
' 利用內設的數據庫連接信息
Public Function dbQueryToArray(sql As String, _
Optional ByVal sqlConnectString As String = "this")
dbConnectSQL sqlConnectString
On Error GoTo errorhander
rst.Open sql, cnn
dbQueryToArray = rst.GetRows(10000000)
errorhander:
DisplayError sql
End Function
' 查詢數據庫，返回單個數值
' sql: 數據庫查詢語句
' sqlConnectString: 數據庫連接信息，或者直接指定數據庫，比如"Wind"、"JYDB"等，
' 利用內設的數據庫連接信息
Public Function dbQueryOne(sql As String, _
Optional ByVal sqlConnectString As String = "this")
dbConnectSQL sqlConnectString
On Error GoTo errorhander
rst.Open sql, cnn
dbQueryOne = rst.Fields.Item(0).value
errorhander:
dbDisplayError sql
End Function
' 查詢數據庫，返回單個數值
' sql: 數據庫查詢語句
' sqlConnectString: 數據庫連接信息，或者直接指定數據庫，比如"Wind"、"JYDB"等，
' 利用內設的數據庫連接信息
Public Function dbQueryToCell(sql$, Optional rng As Excel.Range, _
Optional ByVal sqlConnectString$ = "this", _
Optional withHeader As Boolean = True)
On Error GoTo error_handler
dbConnectSQL sqlConnectString
rst.Open sql, cnn
Set rng = rng.Cells(1, 1)
If withHeader = True Then
Dim i As Long
For i = 0 To rst.Fields.Count - 1
rng.Offset(0, i).value = rst.Fields(i).Name
Next
rng.Offset(1, 0).CopyFromRecordset rst
Else
rng.CopyFromRecordset rst
End If
error_handler:
dbDisplayError sql
End Function
' 執行任意數據庫語句，無返回結果。如需返回結果，請使用Query、QueryOne、QueryToCell等函數
' sql: 數據庫查詢語句
' sqlConnectString: 數據庫連接信息，或者直接指定數據庫，比如"Wind"、"JYDB"等，利用內設的數據庫連接信息
Sub dbExec(ByVal sql As String, _
Optional ByVal sqlConnectString As String = "this")
dbConnectSQL sqlConnectString
On Error GoTo errorhander
cnn.Execute sql
errorhander:
dbDisplayError sql
End Sub
' 這個函數用來上傳壹個Excel區域到數據庫，數據表必須事先建好，並且包括Excel區域的第壹行
' Database.InsertRange(table, rng, sqlConnectString, isEmpty)
' table：Excel數據將上傳到這個表內
' rng: 將被上傳的Excel區域
' sqlConnectString: 數據庫連接字符串
' isEmpty: 是否清空原有表格數據
Public Function dbInsertRange(table$, rng As Excel.Range, Optional ByVal sqlConnectString$ = "this", _
Optional isEmpty As Boolean = False)
dbConnectSQL sqlConnectString
On Error Resume Next
If isEmpty Then dbExec "delete from " & table, sqlConnectString$
Dim r As Long, sqlHead$, i As Long
' 首選根據isEmpty選項，刪除原表內所有數據
For i = 1 To rng.Columns.Count
sqlHead = sqlHead & ",[" & rng.Cells(1, i) & "]"
Next i
' 其次，依次拆入每行
' 目前每壹行都需運行壹個SQL語句，效率較低，如果數據量較大，可能會引起Excel死機
sqlHead = "insert into " & table & " (" & mid(sqlHead, 2, 10000000) & ") values "
For r = 2 To rng.rows.Count
Dim sql$
sql = ""
For i = 1 To rng.Columns.Count
Dim v
v = rng.Cells(r, i).value()
If IsError(v) Then v = ""
If IsDate(v) Then
sql = sql & ",'" & Format(v, "yyyy-mm-dd") & "'"
ElseIf v <> "" And IsNumeric(v) Then
sql = sql & "," & v
Else
sql = sql & ",'" & v & "'"
End If
Next i
dbExec sqlHead & " (" & mid(sql, 2, 1000000) & ")", sqlConnectString$
Next r
End Function
' 查詢存儲過程，返回的是ADODB.RecordSet對象
Public Function dbQueryStoredProc(procName$, para, _
Optional ByVal sqlConnectString As String = "this", _
Optional returnPara As Boolean = True) As Object 'ADODB.Recordset
On Error GoTo errorhander
dbConnectSQL sqlConnectString
With com
.ActiveConnection = cnn
.CommandType = adCmdStoredProc
.CommandText = procName
' 獲取存儲過程的參數定義
.Parameters.Refresh
' 如果存在輸出參數，則刪除它，默認第壹個為輸出參數
On Error Resume Next
If returnPara Then .Parameters.Delete 0
' 設置輸入參數的值
If IsArray(para) Then
Dim i
For i = 0 To UBound(para)
.Parameters.Item(i).value = para(i)
Next i
End If
' 改變輸入參數大小
Dim tmpp
For Each tmpp In .Parameters
tmpp.Size = 255
Next tmpp
' 獲取參數返回值
Set dbQueryStoredProc = .Execute()
End With
errorhander:
DisplayError sql
End Function
Private Sub dbClose()
' 當類被註銷時，斷開數據庫連接
On Error Resume Next
If cnn.State <> 0 Then cnn.Close
End Sub
' 連接數據庫
' 此處首先檢查cnn是否已經連接到想要連接的數據庫，如果已經連接，將不產生任何操作
' 本Database對象在對象存續過程中，不會主動斷開；
' 只有在對象註銷之時，才斷開數據庫，如需斷開數據庫連接，請set db = nothing
Private Function dbConnectSQL(ByVal sqlConnectString$) As String
On Error Resume Next
Call dbInitialize
If sqlDict.Exists(LCase(sqlConnectString)) Then
sqlConnectString = sqlDict.Item(LCase(sqlConnectString))
End If
If rst Is Nothing Then Set rst = CreateObject("ADODB.Recordset")
If cnn Is Nothing Then Set cnn = CreateObject("ADODB.Connection")
If cnn.State <> 1 Or lastCnn <> sqlConnectString Then
cnn.Close
Set cnn = Nothing
Set cnn = CreateObject("ADODB.Connection")
cnn.Open sqlConnectString
lastConn = sqlConnectString
End If
dbConnectSQL = sqlConnectString
End Function
' 顯示查詢數據庫過程中出現的錯誤信息，信息被顯示在立即窗口。
Private Sub dbDisplayError(sql$)
Dim e
If cnn.Errors.Count > 0 Then
Debug.Print cnn.Errors.Count & " errors found when exec """ & sql & """"
For Each e In cnn.Errors
Debug.Print "Error info: " & e.description & " Source: " & e.Source
Next e
End If
End Sub