Access 2007/2010 Validate Userid and password using ADO

Private Sub ContinToDisp_Click()
'******************************* Set paths to Template **********************
Path1 = CurrentProject.Path
Path2 = "\FleetMarineUser\"
Path3 = Me.cboTemplateID
Templat = "MainSCGTemplate112511"
Strtxt1 = SCGTitle
'SCGPassword = "SCGTemplate"

'Check to see if data is entered into the TemplateID combo box
    If IsNull(Me.cboTemplateID) Or Me.cboTemplateID = "" Then
      MsgBox "You must enter a SCG ID.", vbOKOnly, "Required Data"
        Me.cboTemplateID.SetFocus
        Exit Sub
    End If

    'Check to see if data is entered into the password box
    If IsNull(Me.txtPassword) Or Me.txtPassword = "" Then
      MsgBox "You must enter a Password.", vbOKOnly, "Required Data"
        Me.txtPassword.SetFocus
        Exit Sub
    End If


'*******************Check database for valid SCG Number
Set rs = New ADODB.Recordset
Me.cboTemplateID.SetFocus
sSQL = "Select * from OCATempTable where SCGNumber = '" & cboTemplateID & "' AND  PassList ='" & Me.txtPassword & "'"

 
rs.Open sSQL, CurrentProject.Connection
If Not rs.EOF Then
' Open Template to Copy
    Set objXLApp = CreateObject("Excel.Application")
    Set objXLBook = objXLApp.Workbooks.Open(Path1 & Path2 & Templat)
    Set objXLSheet = objXLBook.Worksheets
    objXLApp.Application.Visible = True
'************ Create WorkBook For user WorkBook Name = TemplateID
    objXLApp.ActiveWorkBook.SaveAs (Path1 & Path2 & Path3)

'Open and close the proper Screens
DoCmd.Close acForm, "SignOn", acSaveNo
DoCmd.OpenForm "MyActions"

'send to Main Table
CurrentDb.Execute "QrySCGTab", dbFailOnError
' Delete the record from the SCGTemporaryTable
CurrentDb.Execute "QryDelSCG", dbFailOnError

Exit Sub
End If

'Check if in the SCGTable
Set rsSCGTable = New ADODB.Recordset
sSQLSCGTable = "Select * from SCGTable where SCGNumber = '" & cboTemplateID & "' AND  PassList ='" & Me.txtPassword & "'"
rsSCGTable.Open sSQLSCGTable, CurrentProject.Connection
If rsSCGTable.EOF Then
    MsgBox "Invalid Login, please try again", vbOKOnly, "Required Data"
        Me.cboTemplateID.SetFocus
    Exit Sub
    Else
' Open Template that has already been created
    Set objXLApp = CreateObject("Excel.Application")
    Set objXLBook = objXLApp.Workbooks.Open(Path1 & Path2 & Path3)
    Set objXLSheet = objXLBook.Worksheets
    objXLApp.Application.Visible = True
    
'Open and close the proper Screens
DoCmd.Close acForm, "SignOn", acSaveNo
DoCmd.OpenForm "MyActions"

End If

  rs.Close
  Set rs = Nothing
  rsSCGTable.Close
  Set rsSCGTable = Nothing

    'If User Enters incorrect password 3 times database will shutdown
    intLogonAttempts = intLogonAttempts + 1
    If intLogonAttempts > 3 Then
      MsgBox "You do not have access to this database.Please contact admin.", _
               vbCritical, "Restricted Access!"
        Application.Quit
    End If
    
End Sub
Private Sub Form_Load()
Dim objXLApp As Object
Dim objXLBook As Object
Dim objXLSheet As Object
'declare variables (tempRecordSet becomes an object variable)
Dim rs As New ADODB.Recordset
Dim rsSCGTable As New ADODB.Recordset
Dim sSQLSCGTable As String
Dim sSQL As String
Dim Path1 As String
Dim Path2 As String
Dim Path3 As String
Dim Strtxt1 As String
Dim Templat As String
Dim SCGPassword As String

Me.cboTemplateID.SetFocus
Me.cboTemplateID = ""
Me.txtPassword = ""
End Sub

Select allOpen in new window