MSSQL数据库导出到Excel

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

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