Link to home
Start Free TrialLog in
Avatar of Lawrence Salvucci
Lawrence SalvucciFlag for United States of America

asked on

Change AD password via MS Access DB

I have the following code that is supposed to change the Active Directory password for the user specified in the code. Every time I try to change it I always get the same error.

Error: Password does not match Password-Restrictions. (Password to short, to long or has already been used by this user.)

I have verified the password policy numerous times and I am putting in the new password correctly. For some reason it never works. If I test it out and put in a bogus username just to see if it errors out in other ways, it does. So I know the code is working somewhat correctly. So how can I get this to work correctly and not give me that error that the password does not match the password-restrictions?

Private Declare Function NetUserChangePassword _
 Lib "Netapi32.dll" (ComputerName As Any, User As Any, _
 OldPass As Any, NewPass As Any) As Long

Private Const ERROR_ACCESS_DENIED = 5&
Private Const ERROR_INVALID_PASSWORD = 86&
Private Const NERR_InvalidComputer = 2351
Private Const NERR_NotPrimary = 2226
Private Const NERR_UserNotFound = 2221
Private Const NERR_PasswordTooShort = 2245
Private Const ERROR_CANT_ACCESS_DOMAIN_INFO = 1351

'Changes the Password for the user "User" on the 
'computer "Server" from "OldPassword" to "NewPassword"
Function ChangeUserPassword(ByVal Server As String, _
  ByVal User As String, ByVal OldPassword As String, _
  ByVal NewPassword As String) As String

    Dim r As Long, msg As String

    'Create Unicode-Arrays
Dim bComputer() As Byte:    bComputer = GetByteArray(Server)
Dim bUser() As Byte:        bUser = GetByteArray(User)
Dim bOldPassword() As Byte: bOldPassword = GetByteArray(OldPassword)
Dim bNewPassword() As Byte: bNewPassword = GetByteArray(NewPassword)
    
    'call API-Function
    r = NetUserChangePassword(bComputer(0), bUser(0), _
      bOldPassword(0), bNewPassword(0))
    
    'check return value and represent as string
    Select Case r 
        Case ERROR_ACCESS_DENIED:    msg = "Error: Access denied."
        Case ERROR_INVALID_PASSWORD: msg = "Error: Invalid password."
        Case NERR_InvalidComputer:   msg = "Fehler: Invalid Computer-/Domainname."
        Case NERR_NotPrimary:        msg = "Error: This operation can only performed on the primary domain controler."
        Case NERR_UserNotFound:      msg = "Error: User not found."
        Case NERR_PasswordTooShort:  msg = "Error: Password does not match Password-Restrictions. (Password to short, to long or has already been used by this user.)"
        Case ERROR_CANT_ACCESS_DOMAIN_INFO
                                     msg = "Error: Error accessing info for domain controler. Maybe the computer is not available or access was denied."
        Case 0:                      msg = "Operation performed successfully."
        Case Else:                   msg = "Error: Unexpected Error " & r & " occured."
    End Select
    
    ChangeUserPassword = msg
End Function

'Converts a Unicode-String to a Unicode-Byte-Array.
'Is used because VB always passes Strings as ANSI instead of Unicode.
Private Function GetByteArray(ByVal str As String) As Byte()
    Dim Buf() As Byte
    Buf = str
    ReDim Preserve Buf(Len(str) * 2 + 1)

    GetByteArray = Buf
End Function

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of Steven Carnahan
Steven Carnahan
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Lawrence Salvucci

ASKER

The user I was testing this out on hasn't changed their password in months so I know that couldn't have been the problem. The minimum password age setting is 30 days. The max password age is 60 days.