'---------------------------------------------------------------------------------------
' Procedure : ValidatePwd
' Author : mellon
' Date : 29/12/2015
' Purpose : Routine found on internet, modified to validate a password that
'Contains
'8 characters AND
'at least 1 numeric AND
'at least 1 Uppercase alphabetic AND
'at least 1 lower case alphabetic
'---------------------------------------------------------------------------------------
'
Public Function ValidatePwd(varPassword As Variant) As Boolean
Dim blnValid As Boolean
Dim blnValidCriteria As Boolean
Dim intChar As Integer
10 On Error GoTo ValidatePwd_Error
'Adjust following line for different length of password******************
' blnValid = Len("" & varPassword) >= 8 And Len("" & varPassword) <= 12
20 blnValid = Len("" & varPassword) = 8 And Len("" & varPassword) = 8
30 If blnValid Then
40 blnValidCriteria = False
50 For intChar = 1 To Len("" & varPassword)
60 If InStr(1, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", Mid(varPassword, intChar, 1), vbBinaryCompare) > 0 Then
70 blnValidCriteria = True
80 Exit For
90 End If
100 Next
110 blnValid = blnValidCriteria
120 End If
130 If blnValid Then
140 blnValidCriteria = False
150 For intChar = 1 To Len("" & varPassword)
160 If InStr(1, "abcdefghijklmnopqrstuvwxyz", Mid(varPassword, intChar, 1), vbBinaryCompare) > 0 Then
170 blnValidCriteria = True
180 Exit For
190 End If
200 Next
210 blnValid = blnValidCriteria
220 End If
230 If blnValid Then
240 blnValidCriteria = False
250 For intChar = 1 To Len("" & varPassword)
260 If InStr(1, "0123456789", Mid(varPassword, intChar, 1), vbBinaryCompare) > 0 Then
270 blnValidCriteria = True
280 Exit For
290 End If
300 Next
310 blnValid = blnValidCriteria
320 End If
330 ValidatePwd = blnValid
340 On Error GoTo 0
350 Exit Function
ValidatePwd_Error:
360 MsgBox "Error " & Err.Number & " On Line " & Erl & " (" & Err.Description & ") in procedure ValidatePwd of Module UtterAccessRelated"
End Function