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

发布: 2007-7-01 20:40 | 作者: admin | 来源: | 查看: 42次 | 进入软件测试论坛讨论

@#新建一个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, "c1.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