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

　''新建一个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