用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