【机房收费系统】——查询上机记录

敲了一天的代码，上上上！！！

'限制特殊字符和字母
Private Sub txtCardNumber_KeyPress(KeyAscii As Integer)
    Dim cTemp As String
    cTemp = "`~!@#$%^&*()-=_+[]{};:'\|<>/?.‘“”’、，。——+（）《》？,~·……￥！：；【】" & """ '禁止输入特殊的字符"
    If InStr(1, cTemp, Chr(KeyAscii)) <> 0 Then
        KeyAscii = 0
    End If
    
    If KeyAscii >= 48 And KeyAscii <= 57 Or KeyAscii = 8 Then
     Else
       KeyAscii = 0
                MsgBox "只能输入数字", vbOKCancel + vbExclamation, "提示"
       txtCardNumber.Text = ""
    End If
End Sub

Private Sub cmdOk_Click()
    Dim mrc As ADODB.Recordset
    Dim MsgText As String
    Dim txtSQL As String
    
    txtSQL = "select * from Line_Info where cardno ='" & txtCardNumber.Text & "'"
    Set mrc = ExecuteSQL(txtSQL, MsgText)

    If Trim(txtCardNumber.Text = "") Then
        MsgBox "卡号为空，请输入卡号！", vbOKOnly + vbExclamation, "警告"
        txtCardNumber.SetFocus
    End If
    
    MSshow.Clear
    With MSshow
        .Rows = 1
        .TextMatrix(0, 0) = "卡号"
        .TextMatrix(0, 1) = "姓名"
        .TextMatrix(0, 2) = "上机日期"
        .TextMatrix(0, 3) = "上机时间"
        .TextMatrix(0, 4) = "下机日期"
        .TextMatrix(0, 5) = "下机时间"
        .TextMatrix(0, 6) = "消费金额"
        .TextMatrix(0, 7) = "余额"
        .TextMatrix(0, 8) = "备注"
    End With
        
        '判断是否存在收取金额记录
        If mrc.EOF = True Then
            MsgBox "没有上机记录！", vbOKOnly + vbInformation, "提示"
            Exit Sub
        Else
            With MSshow
                '判断是否移动到数据集对象的最后一条记录
                Do While mrc.EOF = False
                    .Rows = .Rows + 1
                    .CellAlignment = 4
                    .TextMatrix(.Rows - 1, 0) = Trim(mrc.Fields(1))
                    .TextMatrix(.Rows - 1, 1) = Trim(mrc.Fields(3))
                    .TextMatrix(.Rows - 1, 2) = Trim(mrc.Fields(6))
                    .TextMatrix(.Rows - 1, 3) = Trim(mrc.Fields(7))
                    .TextMatrix(.Rows - 1, 4) = Trim(mrc.Fields(8))
                    .TextMatrix(.Rows - 1, 5) = Trim(mrc.Fields(9))
                    .TextMatrix(.Rows - 1, 6) = Trim(mrc.Fields(11))
                    .TextMatrix(.Rows - 1, 7) = Trim(mrc.Fields(12))
                    .TextMatrix(.Rows - 1, 8) = Trim(mrc.Fields(13))
                    
                    '移动到下一条记录
                    mrc.MoveNext
                Loop
            mrc.Close
            End With
       
         End If
End Sub


Private Sub cmdExport_Click()
    '新建一个Excel文件
    Dim xlAPP As Object
    Dim xlBook As Object
    Dim xSheet As Object
    '导出Excel文件
    Dim i As Long
    Dim j As Integer
    
    On Error GoTo err_proc
    '创建一个电子表格
    Set xlAPP = CreateObject("Excel.application")
    '创建一个工作簿文件
    Set xlBook = xlAPP.workbooks.Add
    '创建一个Sheet表
    Set xSheet = xlBook.worksheets(1)
    With MSshow
        '读取所有行
        For i = 0 To .Rows - 1
        '读取所有列
        For j = 0 To .Cols - 1
        xSheet.cells(i + 1, j + 1).Value = .TextMatrix(i, j)
        Next j
        Next i
    End With
    '使Excel表可见
    xlAPP.Visible = True
    Exit Sub
err_proc:
    Screen.MousePointer = vbDefault
    MsgBox "请确认您的电脑安装了Excel！", vbOKCancel + vbQuestion, "提示"

End Sub