用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, "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

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