機房收費系統——經典代碼

學完機房收費系統之後，發現有很多的經典代碼而且出現的頻率非常高。下面我對這些代碼進行了顆粒歸倉。

下機判斷花費時間和消費金額（固定用戶）

            txtSQL3 = "select * from BasicData_Info "
            Set Object2 = ExecuteSQL(txtSQL3, MsgText3)
            
            If Style = "固定用戶" Then             'DateDiff判斷用戶類型
                basicPay = Val(Trim(Object2.Fields(0)))
                '判斷上機時間是否超過準備時間
                If inttime < Val(Object2.Fields(4)) Then
                    txtCTime.Text = 0
                    txtCMoney.Text = 0
                    returnCash = Val(Trim(txtBaLance.Text) - Trim(txtCMoney.Text))
                    txtBaLance.Text = returnCash
                    mrc.Fields(7) = txtBaLance.Text
                    mrc.Update
                    Call Panduan
                Else           '判斷上機時間是否超過最短時間
                    txtCTime.Text = inttime      '在窗體上顯示上網時間
                    If inttime <= Val(Object2.Fields(3))Then '沒有超過最短時間按最短時間收費
                        txtCMoney.Text = basicPay
                        returnCash = Trim(txtBaLance.Text) - Trim(txtCMoney.Text)
                        txtBaLance.Text = returnCash
                        mrc.Fields(7) = txtBaLance.Text
                        mrc.Update
                        Call Panduan
                    Else
                        If Val(inttime) Mod 30 = 0 Then    '消耗時間，正好等於要求的單位時間
                            txtCMoney.Text = Val(inttime) \ 30 * basicPay \ 2
                            returnCash = Trim(txtBaLance.Text) - Trim(txtCMoney.Text)
                            txtBaLance.Text = returnCash
                            mrc.Fields(7)=txtBaLance.Text '更新表中的cash餘額      
                            mrc.Update
                           Call Panduan
                        Else
                            txtCMoney.Text = (Val(inttime) \ 30 + 1) * basicPay \ 2
                            returnCash = Val(Trim(txtBaLance.Text) - Trim(txtCMoney.Text))
                            txtBaLance.Text = returnCash
                            mrc.Fields(7) = txtBaLance.Text   '更新表中cash餘額
                            mrc.Update
                            Call Panduan
                        End If
                    End If
                End If

導出Excel表 

Dim ExcelApp As Excel.Application   '聲明Excal對象
    Dim ExcelBook As Excel.Workbook     '聲明工作簿對象
    Dim ExcelSheet As Excel.Worksheet   '聲明工作表單
    Dim ExcelRange As Excel.Range
    
    Dim i As Integer
    Dim j As Integer
    
    Set ExcelApp = CreateObject("Excel.application")    '調用Excel程序，創建Excel應用程序對象
    Set ExcelBook = ExcelApp.Workbooks.Add  '創建新的空白工作簿
    Set ExcelSheet = ExcelBook.Worksheets(1)    '創建新的工作表單
    
    DoEvents
    If MSFlexGrid1.Rows <= 1 Then
        MsgBox "沒有可導出數據！", vbOKOnly, "溫馨提示"
    End If
    
    With MSFlexGrid1
        For i = 0 To .Rows - 1      '循環添加行內容
            For j = 0 To .Cols - 1  '循環添加列內容
            DoEvents
            '添加單元格內容
            ExcelApp.ActiveSheet.Cells(i + 1, j + 1) = .TextMatrix(i, j)
            
            Next j
        Next i
    End With
    
    ExcelApp.ActiveWorkbook.Saved = True        '保存Excel表格
    MsgBox "導出成功！", vbOKOnly, "溫馨提示"
    ExcelApp.Visible = True     '顯示Excel表格
    
    Set ExcelApp = Nothing      '釋放ExcelApp對象
    Set ExcelBook = Nothing     '釋放ExcelBook對象
    Set ExcelSheet = Nothing    '釋放ExcelSheet對象

修改密碼判斷

    Dim txtSQL, MsgText As String
    Dim mrc As ADODB.Recordset
    '判斷兩個文本框的內容是否一致
    If Trim(txtnewpwd.Text) <> Trim(txtokpwd.Text) Then
        MsgBox "兩次密碼輸入不一致", 48, "警告 "
        txtnewpwd.Text = ""
        txtokpwd.Text = ""
        txtnewpwd.SetFocus
    Else
        '連接User表
        txtSQL = "select * from user_Info where userID = '" & Trim(UserName) & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        '判斷表中字段一和txtnewpwd的內容是否一致
        If (Trim(mrc.Fields(1)) = Trim(txtnewpwd.Text)) Then
            MsgBox "與舊密碼重複，請重新修改！"
            txtnewpwd.Text = ""
            txtokpwd.Text = ""
            txtnewpwd.SetFocus
        Else
            '判斷表中字段一和txtoldpwd的內容是否一致
            If (Trim(mrc.Fields(1)) <> Trim(txtoldpwd.Text)) Then
                MsgBox "請輸入正確的舊密碼！"
                txtoldpwd.Text = ""
            Else
                '當表中字段一等於txtnewpwd的內容時
                mrc.Fields(1) = Trim(txtnewpwd.Text)
                mrc.Update
                MsgBox "密碼修改成功！", 48, "修改密碼" '顯示修改密碼成功
                mrc.Close
                Unload Me       '卸載窗體
            End If
        End If
    End If