Unprotect on open
I use an Access database on our shared network to validate against. You will
need to add the appropriate references.
Public Pass As Boolean
Dim cn As ADODB.Connection, rs As ADODB.Recordset, intColIndex As Integer
Public Sub UrIdentity()
Pass = False
Set TargetRange = Range("X1")
Set cn = New ADODB.Connection
DBFullName = "P:\Permanent_Data\Patrick\Security.mdb"
TableName = "Authorized"
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName &
";"
Set rs = New ADODB.Recordset
With rs
.Open "SELECT * FROM " & TableName & " WHERE Emp LIKE '" &
UCase(frmLogIn.txtUserNumb) & "'", cn, , , adCmdText
For intColIndex = 0 To rs.Fields.Count - 1 ' the field names
TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
Next
TargetRange.Offset(0, 0).CopyFromRecordset rs ' the recordset data
End With
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
If Range("X1").Value < "Emp" And Range("Y1").Value < "" Then
Pass = True
Else
Pass = False
End If
Range("X1:Y1").ClearContents
Range("A2").Select
End Sub
|