Beginner Needing Suggestions

[maurices5000]

Hi, I have some working code but would like to code it a little better than i'm currently doing. I'm using VB 6.0. I know that making the code Object Oriented would be better but i'm not there yet and hope t be in the near future. Please give me your suggestions. Thanks!

This is just one of many procedures. But the suggestions that you give me will likely help me in other areas. Thanks!

Private Function SearchEmployeeDatabase(sFirstName As String, sLastName As String, sBadge As String, sDepartment As String, sCenter As String, sDate As String) As Integer
 
'Declarations Section
Dim adoConnection As ADODB.Connection    'Used to establish connection with the Employee Database
Dim adoRecordset As ADODB.Recordset      'Used to query the Employee table
Dim connString As String                 'Stores connection string
Dim SQLstr As String                     'Stores query
'Dim iEmployeeID As Integer              'Stores the Employee's ID in Database
Dim iResponse As Integer                 'Stores response from message box
Dim boolSaveToDB As Boolean              'Stores value indicating whether to save to DB or not
Dim x As Integer                         'Counter for For Loop
Dim sPreviousLastName As String          'Used in case of change in last name
 
On Error GoTo AdoErrors
'Establish connection with FAE database
Set adoConnection = New ADODB.Connection
 
connString = "Provider=microsoft.jet.oledb.4.0;Data source=" & App.Path & "\FAEDB2.2.mdb; Jet OLEDB:Database password=f.a.e.1.0"
 
adoConnection.Open connString
 
'Verifies database connection
If adoConnection.State = adStateOpen Then
     'Debug.Print "Connection was established"
 
   SQLstr = "SELECT * From Employees WHERE BadgeNumber='" & sBadge & "'"
          
   'Create Recordset Object and Search Employee Database
   Set adoRecordset = New ADODB.Recordset
 
   With adoRecordset
        .Open SQLstr, adoConnection, adOpenKeyset, adLockOptimistic, adCmdText
    
   'Gather employee information
   If .RecordCount = 1 Then
      
      If .Fields("FName").Value = sFirstName And .Fields("LName").Value = sLastName Then
        'If this is the same name,Do all of this
        gbDuplicatedBadge = False
      
        'Stores Employee ID in variable
        gEmployee.EmployeeID = .Fields("EmpID").Value
      
        'Check to see if user has changed departments or centers
        If .Fields("DeptID").Value = cboDepartment.ItemData(cboDepartment.ListIndex) Then
            'Do nothing
        Else
            'Department changed. Save new department value to DB
            .Fields("DeptID").Value = cboDepartment.ItemData(cboDepartment.ListIndex)
        End If
         
        If .Fields("CenterID").Value = cboCenter.ItemData(cboCenter.ListIndex) Then
            'Do nothing
        Else
            'Center changed. Save new department value to DB
            .Fields("CenterID").Value = cboCenter.ItemData(cboCenter.ListIndex)
        End If
        .Update
        .MoveNext
 
      ElseIf .Fields("FName").Value = sFirstName Then 'Assumes a possible change in last name
        'Ask if user's last name changed.
        iResponse = MsgBox("This badge number is already in use. Has your last name changed?", vbQuestion + vbYesNo, "Duplicated Badge Numbers")
        If iResponse = vbNo Then
            iResponse = MsgBox("Someone is already using this badge number. Would you like to make corrections?", vbExclamation + vbYesNo, "Duplicated Badge Numbers")
            If iResponse = vbNo Then
                'Show message box if user does not change badge numbers.
                MsgBox "A note will be placed on your exam printout. Please send a copy to the PI Department so that the duplicated badge numbers can be resolved.", vbInformation + vbOKOnly, "Duplicated Badge Numbers"
                gbDuplicatedBadge = True
                boolSaveToDB = True
            Else
                gbDuplicatedBadge = False
                boolSaveToDB = False
                txtBadge.SetFocus
                
                'Close recordset and connection
                adoRecordset.Close
                Set adoRecordset = Nothing
                adoConnection.Close
                Set adoConnection = Nothing
                
                SearchEmployeeDatabase = vbCancel
                Exit Function
            End If
        Else
            Do
            'Prompt user to enter previous last name
            sPreviousLastName = InputBox("Please enter your previous last name and press enter.", "Changing Last Name")
            
            Loop While sPreviousLastName = ""
            
            sPreviousLastName = FormatText(sPreviousLastName)
            
            'Check user's previous last name with last name in DB
            If UCase(sPreviousLastName) = UCase(.Fields("LName").Value) Then
                'Place code here that will update last name
                adoRecordset!lname = sLastName
                adoRecordset.Update
                adoRecordset.MoveNext
                
                MsgBox "Your last name has been updated!", vbInformation + vbOKOnly, "Duplicated Badge Numbers"
                boolSaveToDB = False
            Else
                MsgBox "There is no record of " & sPreviousLastName & " in the database.", vbExclamation + vbOKOnly, "Changing Last Name"
                boolSaveToDB = False
                
                'Close recordset and connection
                adoRecordset.Close
                Set adoRecordset = Nothing
                adoConnection.Close
                Set adoConnection = Nothing
            
                SearchEmployeeDatabase = vbCancel
            End If
        End If
      Else
        'Ask if user would like to change badge number.
        iResponse = MsgBox("Someone is already using this badge number. Would you like to make corrections?", vbExclamation + vbYesNo, "Duplicated Badge Numbers")
        If iResponse = vbNo Then
            'Show message box if user does not change badge numbers.
            MsgBox "A note will be placed on your exam printout. Please send a copy to the PI Department so that the duplicated badge numbers can be resolved.", vbInformation + vbOKOnly, "Duplicated Badge Numbers"
            gbDuplicatedBadge = True
            boolSaveToDB = True
        Else
            gbDuplicatedBadge = False
            boolSaveToDB = False
            txtBadge.SetFocus
            
            'Close recordset and connection
            adoRecordset.Close
            Set adoRecordset = Nothing
            adoConnection.Close
            Set adoConnection = Nothing
                
            SearchEmployeeDatabase = vbCancel
            Exit Function
        End If
      End If
   ElseIf .RecordCount > 1 Then
        'Ask if user would like to change badge number.
        iResponse = MsgBox("Someone is already using this badge number. Would you like to make corrections?", vbExclamation + vbYesNo, "Duplicated Badge Numbers")
        If iResponse = vbNo Then
            'Show message box if user does not change badge numbers.
            MsgBox "A note will be placed on your exam printout. Please send a copy to the PI Department so that the duplicated badge numbers can be resolved.", vbInformation + vbOKOnly, "Duplicated Badge Numbers"
                        
            'Check to see if one of the duplicated badge numbers belong to user.
            For x = 0 To .RecordCount - 1
               If .Fields("FName").Value = sFirstName And .Fields("LName").Value = sLastName Then
                  'If one of the names match, do this
                  'Stores Employee ID in variable
                  gEmployee.EmployeeID = .Fields("EmpID").Value
            
                  gbDuplicatedBadge = True
                  
                  
                  'Check to see if user has changed departments or centers
                  If .Fields("DeptID").Value = cboDepartment.ItemData(cboDepartment.ListIndex) And _
                     .Fields("CenterID").Value = cboCenter.ItemData(cboCenter.ListIndex) Then
                     'Do nothing
                  ElseIf .Fields("DeptID").Value = cboDepartment.ItemData(cboDepartment.ListIndex) Then
                     'Do nothing
                  Else
                     'Change save new department value to DB
                     adoRecordset!DeptID = cboDepartment.ItemData(cboDepartment.ListIndex)
                  End If
         
                  If .Fields("CenterID").Value = cboCenter.ItemData(cboCenter.ListIndex) Then
                     'Do nothing
                  Else
                     'Change save new department value to DB
                     adoRecordset!CenterID = cboCenter.ItemData(cboCenter.ListIndex)
                  End If
                  
                .Update
                
                Exit For

[maurices5000]

'Looks for last record before EOF and allows new, yet duplicated employee info to be entered into the DB
               ElseIf x = .RecordCount - 1 Then
                    gbDuplicatedBadge = True
                    boolSaveToDB = True
               End If
               .MoveNext
            Next
        Else
            gbDuplicatedBadge = False
            boolSaveToDB = False
            txtBadge.SetFocus
            
            'Close recordset and connection
            adoRecordset.Close
            Set adoRecordset = Nothing
            adoConnection.Close
            Set adoConnection = Nothing
            
            SearchEmployeeDatabase = vbCancel
            Exit Function
        End If
    
   ElseIf .RecordCount = 0 Then
          'Assigns zeros values since above fields are null
          gPatSafetyGoals.Score = 0
          gEnvironmentCare.Score = 0
          gInfectionControl.Score = 0
          gHumanResource.Score = 0
          gPI_Process.Score = 0
          gOSHA.Score = 0
          gConfidentiality.Score = 0
          gHIPAA.Score = 0
          gCompliance.Score = 0
          gJCAHO.Score = 0
          
          boolSaveToDB = True
   End If
 
 'Insert Employee if no record of employee is found
 If boolSaveToDB Then
    .AddNew
    .Fields("FName").Value = sFirstName
    .Fields("LName").Value = sLastName
    .Fields("BadgeNumber").Value = sBadge
    .Fields("DeptID").Value = cboDepartment.ItemData(cboDepartment.ListIndex)
    .Fields("CenterID").Value = cboCenter.ItemData(cboCenter.ListIndex)
    .Update
     'Debug.Print adoRecordset!fname
 End If
    .Close
End With
 
  Set adoRecordset = Nothing
  
  adoConnection.Close
  Set adoConnection = Nothing
  
  SearchEmployeeDatabase = vbYes
 
Else
   'Informs user that connection failed and uses alternative to save employee data
   MsgBox "This application could not establish a connection. Please ask your office manager to contact the PI Department."
   adoConnection.Close
   Set adoConnection = Nothing
 
   gsSaveEmpInfoToFile = vbYes
End If
Exit Function
 
AdoErrors:
'Errorhandling Declarations
Dim errCollection As ADODB.Errors       'ADO Errors Object
 
'In case the adoConnection is not established or there were other initiation problems
On Error Resume Next
SearchEmployeeDatabase = vbNo  'This may need to be changed if the error is not a DB error.
 
Set errCollection = adoConnection.Errors
 
ErrorLog errCollection
End Function

[si_the_geek]

I haven't been thorough, but here's some advice on what I've looked at:

1) The return type of the function is an Integer, yet you return values like vbCancel and vbNo; I would recommend usingthe appropriate enum if you can (in this case possibly vbMsgBoxConstants), as it makes working with the return values easier from the calling code.

2) You have a little inconsistency in your style of referencing fields, sometimes you use .Fields("LName").Value and others you use adoRecordset!lname . I would recommend always using the first method as it is easier to read, and I think it works slightly faster. It also doesn't get binding errors, which I think the ! notation can.

3) There's no need to store the result of a message box, you can use it directly in the If statement (or a Select Case if there are 3 buttons), eg:

If MsgBox("This badge number is already in use. Has your last name changed?", vbQuestion + vbYesNo, "Duplicated Badge Numbers") = vbNo Then
            If MsgBox("Someone is already using this badge number. Would you like to make corrections?", vbExclamation + vbYesNo, "Duplicated Badge Numbers") = vbNo Then

I prefer to split each parameter on to a separate line to make it easier to read, eg:

If MsgBox("This badge number is already in use. Has your last name changed?" _
                  , vbQuestion + vbYesNo _
                  , "Duplicated Badge Numbers")  _
                  = vbNo Then
            If MsgBox("Someone is already using this badge number. Would you like to make corrections?" _
                    , vbExclamation + vbYesNo _
                    , "Duplicated Badge Numbers")  _
                    = vbNo Then

4) Near the start of the function you check that the connection is open (good stuff), however you need to scroll to the end of the function to read the 'not connected' code (which is a long way!). It would be easier to read the function if you swapped the If around, so instead of:

'Verifies database connection
If adoConnection.State = adStateOpen Then
 
 '(lots of code)
 
Else
   'Informs user that connection failed and uses alternative to save employee data
   MsgBox "This application could not establish a connection. Please ask your office manager to contact the PI Department."
   adoConnection.Close
   Set adoConnection = Nothing
 
   gsSaveEmpInfoToFile = vbYes
End If

you could have:

'Verifies database connection
If adoConnection.State <> adStateOpen Then
   'Informs user that connection failed and uses alternative to save employee data
   MsgBox "This application could not establish a connection. Please ask your office manager to contact the PI Department."
   adoConnection.Close
   Set adoConnection = Nothing
 
   gsSaveEmpInfoToFile = vbYes
Else
 
 '(lots of code)
 
End If

In general your code looks good

[maurices5000]

Thanks man! and that from a Moderator! I was afraid i would get: "This is totally crap! Start over!"

I was actually very much afraid. You helped my confidence level.

I will use your suggestions! I might have mixed ADO syntax because i was just learning at the time and was trying to remember how to use both.

[maurices5000]

Based on what you said above, my only question was about the Function type. You stated that my return type was integer but i returned values such as vbCancel. Well i thought that was an integer. :-)

So can i create a Public Function FunctionName (...) As vbMsgBoxConstants?

Maybe i misunderstood because that looks funny.

I've also heard that it is best to use the Insert statements instead of ADO. If that is true, should worry about changing all my code or just leave it the same?

Thanks!

[si_the_geek]

Thanks man! and that from a Moderator! I was afraid i would get: "This is totally crap! Start over!"

well... I didn't wanna say it, but... naa, you're definitely on the right track

You stated that my return type was integer but i returned values such as vbCancel. Well i thought that was an integer. :-)

Technically yes, but only a few specific values, rather than the entire range of an Integer.

If you return an enum then the values of the enum (like vbYes etc) will be listed when you type [i]FunctionName(parameters) =[i] in the calling code. In this situation you wont see much benefit, but if you use the function again later you will. Note that most/all of the VB built in functions return values like this when appropriate (and use them for the parameters).

By the way, I was wrong about the name of the Enum, it is actually VbMsgBoxResult rather than vbMsgBoxConstants.

I've also heard that it is best to use the Insert statements instead of ADO. If that is true, should worry about changing all my code or just leave it the same?

It's debatable whether an Insert is better than using a recordset. For a single record there aren't any particularly significant reasons to use one or the other (for copying lots of data from one table to another, an Insert is definitely better).