用DLL实现把数据库的记录导出到EXCEL中(VB)

´新建一个ActiveX DLL工程工程名为DbToExcel
´工程-->引用,引用Microsoft ActiveX Data Objects 2.6 Library
´Microsoft Excel 9.0 Objects Library

Option Explicit

Private Mcnnquery As ADODB.Connection   ´定义ADO连接对象
Private Mrsquery As ADODB.Recordset     ´定义ADO记录对象
Dim ObjExcel As Excel.Application   ´定义Excel对象
Dim ObjWorkBook As Excel.Workbook   ´定义工作薄
Dim ObjSheet As Excel.Worksheet     ´定义工作表
Dim ObjRange As Excel.Range         ´定义用户使用工作表的范围

Private Property Set Connquery(ByVal Conn As ADODB.Connection)
    Set Mcnnquery = Conn
End Property

Private Property Get Connquery() As ADODB.Connection
    Set Connquery = Mcnnquery
End Property

Private Property Set Rsquery(ByVal Rs As ADODB.Recordset)
    Set Mrsquery = Rs
End Property

Private Property Get Rsquery() As ADODB.Recordset
    Set Rsquery = Mrsquery
End Property

´属性方法共有三个参数
´strcnn 连接对象
´strrs  数据集对象
´strpath EXCEL文件
Public Sub DbtoExcel(Strcnn As ADODB.Connection, Strrs As ADODB.Recordset, Strpath As String)
    Dim i As Integer, j As Integer
On Error GoTo Err
    Set Connquery = Strcnn ´设置cnnquery属性
    Set Rsquery = Strrs   ´设置rsquery属性
    Set ObjExcel = New Excel.Application
    Set ObjWorkBook = ObjExcel.Workbooks.Open(Strpath)  ´打开EXCEL文件
    Set ObjSheet = ObjWorkBook.ActiveSheet
    Set ObjRange = ObjSheet.UsedRange ´用户使用过的工作表范围
    For i = 1 To Rsquery.Fields.Count
        ObjRange.Cells(1, i) = Rsquery.Fields(i - 1).Name
    Next i
    For j = 1 To Rsquery.RecordCount
        For i = 0 To Rsquery.Fields.Count - 1
            ObjRange.Cells(j + 1, i + 1) = Rsquery.Fields(i).Value
        Next i
        Rsquery.MoveNext
    Next j
    ObjExcel.Quit
    Set ObjWorkBook = Nothing
    Set ObjRange = Nothing
    Set ObjSheet = Nothing
    Set ObjExcel = Nothing
Err:
    MsgBox Err.Number & " " & Err.Description
    Set ObjWorkBook = Nothing
    Set ObjRange = Nothing
    Set ObjSheet = Nothing
    Set ObjExcel = Nothing
End Sub

´文件-->生成DbToExcel.dll

´新建一个标准EXE工程
´工程-->引用Microsoft ActiveX Data Objects 2.6 Library
浏览，加载刚才生成的DLL文件

Option Explicit
 
Dim Conn As ADODB.Connection
Dim Rs As ADODB.Recordset

Dim DE As New DbtoExcel.Class1  ´定义一个类，DbToExcel.DLL内Class1类的一个实例

Private Sub Command1_Click()
    DE.DbtoExcel Conn, Rs, "c\1.xls"
End Sub

Private Sub Form_Load()
    Set Conn = New ADODB.Connection
    Set Rs = New ADODB.Recordset
    Conn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=C:\db.mdb;Persist Security Info=False"
    Conn.Open
    Rs.Open "select * from users", Conn, adOpenKeyset, adLockBatchOptimistic
End Sub

原文转自：http://www.ltesting.net