从SQL数据库导出到Excel

    实际生活中常常要将 一些数据导入到Excel表格中,方便操作如打印等.机房收费系统中关于充值记录的N多查询结果均是如此.我把两个窗体的结果分别从两个方面实现了这个功能,总结在下面和大家分享.

第一种,将已经查询到的结果用MSFlexGrid控件显示出来,然后从该控件导出.

Option Explicit
Private Sub cmdExport_Click()
    Dim i As Long
    Dim j As Long

    On Error Resume Next
    If myMSFlexGrid.TextMatrix(1, 0) = "" Then
        MsgBox "没有数据导出", vbInformation, "提示"
        Exit Sub
    End If

    Dim excelApp As Excel.Application
    Set excelApp = New Excel.Application
    Set excelApp = CreateObject("Excel.Application")
    Dim exbook  As Excel.Workbook
    Dim exsheet  As Excel.Worksheet
    Set exbook = excelApp.Workbooks.Add

    excelApp.SheetsInNewWorkbook = 1
    excelApp.Visible = True
    '   Me.MousePointer = vbHourglass '控制鼠标为读取数据

    With excelApp.ActiveSheet
        For i = 1 To myMSFlexGrid.Rows
            For j = 1 To myMSFlexGrid.Cols
                .Cells(i, j).Value = "" & Format$(myMSFlexGrid.TextMatrix(i - 1, j - 1))
            Next j
        Next i
    End With
    '   Me.MousePointer = 0 '释放鼠标为读取数据
    Set exsheet = Nothing
    Set exbook = Nothing
    Set excelApp = Nothing

End Sub

Private Sub cmdQuery_Click()
    Dim strSQL As String
    Dim MsgText As String
    Dim mrc As ADODB.Recordset

    If Testtxt(txtCardNo.Text) Then
        MsgBox "请输入卡号!", vbOKOnly + vbExclamation, "提示"
        txtCardNo.SetFocus
        Exit Sub
    End If

    If Not IsNumeric(txtCardNo.Text) Then
        MsgBox "请输入数字!", vbOKOnly + vbExclamation, "提示"
        txtCardNo.SetFocus
        Exit Sub
    End If

    strSQL = "select cardno 卡号,addcash 充值金额,date 充值日期,time 充值时间,userid 充值教师 from recharge_info where cardno='" & txtCardNo.Text & "'"
    Set mrc = ExecuteSQL(strSQL, MsgText)

    If mrc.EOF = True Then
        MsgBox "此卡不存在!", vbOKOnly + vbExclamation, "提示"
        txtCardNo.Text = ""
        txtCardNo.SetFocus
        Exit Sub
    End If

    With myMSFlexGrid
        .Rows = 1
        .CellAlignment = 4
        Dim k As Integer
        For k = 0 To mrc.Fields.Count - 1
            .TextMatrix(0, k) = mrc.Fields(k).Name
            .ColWidth(k) = 1300
        Next k

        Do While mrc.EOF = False
            .Rows = .Rows + 1
            .TextMatrix(.Rows - 1, 0) = mrc.Fields("卡号").Value
            .TextMatrix(.Rows - 1, 1) = mrc.Fields("充值金额").Value
            .TextMatrix(.Rows - 1, 2) = mrc.Fields("充值日期").Value
            .TextMatrix(.Rows - 1, 3) = mrc.Fields("充值时间").Value
            .TextMatrix(.Rows - 1, 4) = mrc.Fields("充值教师").Value
            mrc.MoveNext
        Loop

    End With
End Sub

第二种 , 也是将查询到的结果用 MSFlex Grid 控件显示出来 , 但是从记录集直接导出 .

Option Explicit
   Dim strSQL As String
   Dim MsgText As String
   Dim mrc As ADODB.Recordset
'导出为Excel
Private Sub cmdExport_Click()
    Dim xlapp1 As Excel.Application
    Dim xlbook1 As Excel.Workbook
    Dim xlsheet1 As Excel.Worksheet

    Set xlapp1 = CreateObject("Excel.Application")
    Set xlbook1 = xlapp1.Workbooks.Add
    Set xlsheet1 = xlbook1.Worksheets(1)
        '添加字段名
    Dim i As Integer
    For i = 0 To mrc.Fields.Count - 1
        xlsheet1.Cells(1, i + 1) = mrc.Fields(i).Name
    Next i

    mrc.MoveFirst
    xlsheet1.Range("A2").CopyFromRecordset mrc    
    mrc.Close
    Set mrc = Nothing
    xlapp1.Visible = True
    Set xlapp1 = Nothing
End Sub
'查询某段时间内的充值记录
Private Sub cmdQuery_Click()

    If DTPStart.Value > DTPEnd.Value Then
        MsgBox "请重新选择日期!", vbOKOnly + vbExclamation, "提示"
        DTPStart.SetFocus
        Exit Sub
    End If

    strSQL = "select cardno 卡号,addcash 充值金额,date 充值日期,time 充值时间,userid 充值教师 from recharge_info where date>'" & DTPStart.Value & " '" & "and date<'" & DTPEnd.Value & "'"
    Set mrc = ExecuteSQL(strSQL, MsgText)

    With myMSFlexGrid
        .Rows = 1
        .CellAlignment = 4
        Dim k As Integer
        For k = 0 To mrc.Fields.Count - 1
           .TextMatrix(0, k) = mrc.Fields(k).Name
           .ColWidth(k) = 1300
        Next k
        
        Do While mrc.EOF = False
            .Rows = .Rows + 1
            .TextMatrix(.Rows - 1, 0) = mrc.Fields("卡号").Value
            .TextMatrix(.Rows - 1, 1) = mrc.Fields("充值金额").Value
            .TextMatrix(.Rows - 1, 2) = mrc.Fields("充值日期").Value
            .TextMatrix(.Rows - 1, 3) = mrc.Fields("充值时间").Value
            .TextMatrix(.Rows - 1, 4) = mrc.Fields("充值教师").Value
            mrc.MoveNext
        Loop
    End With
End Sub

我们可以用一个循环的嵌套来实现导入的过程,过程如下

           Dim m As Integer

           Dim n As Integer

           Do While mrc.EOF = False

                 For m = 0 To mrc.RecordCount - 1

                        For n = 0 To mrc.Fields.Count - 1

                                 xlsheet1.Cells(m + 2, n +1).Value = mrc.Fields(n).Value

                       Next n

               Next m

              mrc.MoveNext

       Loop

而上面我只用了一句代码: xlsheet1.Range("A2").CopyFromRecordset mrc,他们的作用完全相同,只是后者省去了写代码的时间,更重要的是我们再也不用在m + 2, n + 1等易错地方纠结了. 

    单一用户登录操作的情况下两种结果是完全一样的.但是,如果有多用户同时操作数据库时,不能保证第一步查询出来的结果和数据库同步,从数据库直接导出的结果可能与显示的结果存在偏差.这样就会使用户对系统可信度产生怀疑.所以我们尽可能按照系统的逻辑需求,严格按照显示结果导出.