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

<script type="text/javascript"> </script> <script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>
<script type="text/javascript"> </script><script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>

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

<script type="text/javascript"> </script> <script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>
<script type="text/javascript"> </script><script type="text/javascript" src="http://pagead2.googlesyndication.com/pagead/show_ads.js"> </script>
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值