Results 1 to 3 of 3
  1. #1
    Join Date
    Feb 2006
    Posts
    5

    Unanswered: Code works but want someone to double check for possible errors please

    Hi all -

    I have an ADP with one form and just want someone to look over my vba code to see if anything looks off....it all works but i just want to make sure im not missing anything especially on closing the connection and recordset objects. Thanks.


    Option Compare Database
    Option Explicit

    Dim cn As New ADODB.Connection 'General Declaration
    Dim rs As New ADODB.Recordset
    Dim rs2 As New ADODB.Recordset


    Dim intUserid As Integer




    Private Sub Exit_Click()
    DoCmd.Quit
    End Sub

    Private Sub Form_Load()

    Dim strSQL As String

    cn.ConnectionString = CurrentProject.Connection
    cn.Open


    strSQL = "select user_id, user_fname + ' ' + user_lname as user_name from tblusers where sign_on ='" & fOSUserName() & "';"
    rs.Open strSQL, cn
    Forms!frmStatsByUser!USER_NAME = rs!USER_NAME

    Forms!frmStatsByUser!SIGN_ON = fOSUserName()

    intUserid = rs!user_id

    Call CleanUp

    Call CheckUserStatus



    DoCmd.Maximize
    End Sub


    Private Sub Submit_Record_Click()
    On Error GoTo Err_Submit_Record_Click


    Dim strSQL As String

    Dim intMsgResult As Integer


    cn.ConnectionString = CurrentProject.Connection
    cn.Open


    strSQL = "select * from tblstatistics where user_id = " & intUserid & " and work_date = '" & [WORK_DATE] & "' and system_id = " & [SYSTEM_ID] & ";"
    rs.Open strSQL, cn

    If rs.RecordCount <> 0 Then
    MsgBox "You have already entered in a record for this day and hospital system. No action taken.", , "Duplicate Record"

    GoTo Exit_Submit_Record_Click
    End If

    If (([SLA_RECEIVED] <> 0) Or ([SLA_PENDING] <> 0)) And SLA_RECEIVED.Enabled = True Then

    strSQL = ""
    strSQL = "select sla_received, sla_processed from tblstatistics where work_date = '" & [WORK_DATE] & "' and system_id = " & [SYSTEM_ID] & ";"
    rs2.Open strSQL, cn

    Do While Not rs2.EOF
    If (rs2!SLA_RECEIVED <> 0) Or (rs2!SLA_PENDING <> 0) Then
    MsgBox ("SLA Received or SLA Pending counts have already been inputted for this hospital system for this date. Please check with any other designated lead to verify SLA counts,,SLA counts already reported for this day")
    GoTo Exit_Submit_Record_Click
    End If

    rs2.MoveNext
    Loop

    End If


    intMsgResult = MsgBox("Are you sure you want to submit? You will not be able to modify these stats once they are saved.", vbYesNo + vbQuestion, "Confirm Submission of Stats")

    If intMsgResult = vbYes Then

    strSQL = ""

    strSQL = "insert into tblstatistics(WORK_DATE,USER_ID,SYSTEM_ID,SLA_RECE IVED,SLA_PROCESSED,SLA_PENDING,PRICE_DISCREPANCIES ,CONTRACT_REVISIONS,CONTRACT_PRICE_UPDATES,PRICE_T APE_ITEMCOUNT,EDI_ACCOUNT_CHANGES,CONTRACT_CONVERS IONS,REPORT_REQUESTS,OTHER_MAINTENANCE,SPECIAL_PRO JECTS_REC,SPECIAL_PROJECTS_PROC,COMMENTS,DATE_CREA TED) " & _
    "values('" & [WORK_DATE] & "'," & intUserid & "," & [SYSTEM_ID] & "," & [SLA_RECEIVED] & "," & [SLA_PROCESSED] & "," & [SLA_PENDING] & "," & [PRICE_DISCREPANCIES] & _
    "," & [CONTRACT_REVISIONS] & "," & [CONTRACT_PRICE_UPDATES] & "," & [PRICE_TAPE_ITEMCOUNT] & "," & [EDI_ACCOUNT_CHANGES] & "," & [CONTRACT_CONVERSIONS] & _
    "," & [REPORT_REQUESTS] & "," & [OTHER_MAINTENANCE] & "," & [SPECIAL_PROJECTS_REC] & "," & [SPECIAL_PROJECTS_PROC] & ",'" & [COMMENTS] & "',getdate())"

    cn.Execute strSQL

    MsgBox "Your Stats have been submitted", , "Success!"
    End If



    Exit_Submit_Record_Click:

    Call CleanUp
    Exit Sub

    Err_Submit_Record_Click:
    MsgBox "An error has occurred. Your Stats were not submitted.", , "Operation Cancelled"
    Resume Exit_Submit_Record_Click


    End Sub



    Private Sub SYSTEM_ID_Click()
    [SLA_RECEIVED] = 0
    [SLA_PROCESSED] = 0
    [SLA_PENDING] = 0
    [PRICE_DISCREPANCIES] = 0
    [CONTRACT_PRICE_UPDATES] = 0
    [CONTRACT_REVISIONS] = 0
    [REPORT_REQUESTS] = 0
    [PRICE_TAPE_ITEMCOUNT] = 0
    [EDI_ACCOUNT_CHANGES] = 0
    [CONTRACT_CONVERSIONS] = 0
    [OTHER_MAINTENANCE] = 0
    [SPECIAL_PROJECTS_REC] = 0
    [SPECIAL_PROJECTS_PROC] = 0
    [COMMENTS] = ""


    Call CheckUserStatus


    End Sub

    Private Sub CheckUserStatus()
    Dim strSQL As String
    Dim strFlag As String



    cn.ConnectionString = CurrentProject.Connection
    cn.Open

    strSQL = "select user_id from tblsystem_userleads where system_id = " & [SYSTEM_ID] & ";"
    rs.Open strSQL, cn

    Do While Not rs.EOF
    If rs!user_id = intUserid Then
    strFlag = "T"
    Exit Do
    End If

    rs.MoveNext
    Loop

    If strFlag <> "T" Then
    SLA_RECEIVED.Enabled = False
    SLA_PENDING.Enabled = False
    Else
    SLA_RECEIVED.Enabled = True
    SLA_PENDING.Enabled = True
    End If

    Call CleanUp

    End Sub


    Private Sub CleanUp()


    If rs.State <> adStateClosed Then
    rs.Close
    Set rs = Nothing
    End If
    If rs2.State <> adStateClosed Then
    rs2.Close
    Set rs2 = Nothing
    End If
    If cn.State <> adStateClosed Then
    cn.Close
    Set cn = Nothing
    End If

    End Sub

  2. #2
    Join Date
    Feb 2006
    Location
    Houston, TX USA
    Posts
    16
    Code working is the ultimate test.

  3. #3
    Join Date
    Feb 2004
    Location
    One Flump in One Place
    Posts
    14,912
    Hi

    Nothing major - all looks fairly tight. The only things I would throw in are pop in some error handlers. If your code errors in any proc other than Submit_Record_Click then your clean up code will not get fired.

    Also, if your ADO objects aren't instantiated then your clean up will fail - with no error trap! So - if there was an error with the clean up code when the Submit_Record_Click event called it you would end up in an infinite loop because the Submit_Record_Click error trap would handle the error and then call the Clean Up code again... and so on. Personnally, I would go with the below for the Clean Up:
    Code:
    Private Sub CleanUp()
    'You can handle errors properly if you want. 
    'I use the below becuase the user doesn't care that your app had a problem cleaning up it's objects in the event of an error. 
    'You could trap the error and write it to a file for your own purposes of course. 
    On Error Resume Next
     
    If Not rs Is Nothing Then
        If rs.State <> adStateClosed Then
            rs.Close
        End If
        Set rs = Nothing
    End If
    '.....
    'Remaining code as above
    '.....
    End Sub
    HTH
    Testimonial:
    pootle flump
    ur codings are working excelent.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •