Add UserAccount

Sub Button1_Click()
On Error GoTo Err_Button1_Click

Dim strsAMAccountName
Dim struserPrincipalName
Dim strFullname
Dim strFirstname
Dim strLastname
Dim strScript


For i = 1 To 39    ' I have 39 new users, rows in my Excel sheet

If Range("B" & i) <> "" Then

    strsAMAccountName = Range("B" & i)    
    struserPrincipalName = Range("B" & i)
    strFullname = Range("A" & i)
    strFirstname = Range("E" & i)
    strLastname = Range("D" & i)
    strScript = "Dkttglogon.bat"

     Range("F" & i).Select
     ActiveCell.FormulaR1C1 = "Creating user"
     Range("A" & i).Select
     Selection.Font.ColorIndex = 3
  


    Set objOU = GetObject("LDAP://OU=Users,OU=YOUR_OU,OU=DK,OU=EUR,dc=YOURSUBDOMAIN,dc=YOURDOMAIN,dc=DOTWHAT")
    Set objUser = objOU.Create("User", "cn=" & struserPrincipalName & "")
    objUser.Put "sAMAccountName", strsAMAccountName
    objUser.Put "scriptPath", strScript
    objUser.userPrincipalName = struserPrincipalName
    objUser.Put "initials", " "
    objUser.FullName = strFullname
    objUser.Firstname = strFirstname
    objUser.Lastname = strLastname
    objUser.SetInfo
    
    objUser.SetPassword "Password"   'REMEMBER TO CHANGE BEFORE USE
    objUser.Put "pwdLastSet", 0
    objUser.AccountDisabled = False
    objUser.SetInfo
    

    Range("F" & i).Select
    ActiveCell.FormulaR1C1 = "User Created"
    
Else
    Exit Sub
End If

    Next
    
Exit_Button1_Click:
    Exit Sub

Err_Button1_Click:
    MsgBox Err.Description
    Resume Exit_Button1_Click
    
End Sub