'Create A User

Dim objComputer
Dim nUsers
Dim nUser
Dim objUser
Dim dtStart
Dim dtEnd
Dim nSeconds
Dim fUsersPerSec
Dim sServer

On Error Resume Next
Err.Clear

'Get the name of the server
sServer = UCase(Trim(InputBox("Give me the NetBIOS name of the server you want to add users to:")))
'Connect to that server
Set objComputer = GetObject("WinNT://" & sServer)

If Err.Number = 0 Then
    'Find out how many users to create
    nUsers = CLng(InputBox("How many users do you want to add?"))
    dtStart = Now()
    'Get busy creating them!
    For nUser = 1 to nUsers
        Err.Clear
        Set objUser = objComputer.Create("User","User" & nUser)
        objUser.SetInfo
        If Err.Number = 0 Then
            objUser.SetPassword ("password")
            objUser.FullName = "User " & nUser
            objUser.Description = "User " & nUser & " Description"
            objUser.SetInfo
            'If Err.Number = 0 Then
            '    MsgBox "Created The user!"
            '  Else 
            '    MsgBox "Couldn't modify the newly created user! (" & Err.Number & " - " & Err.Description & ")"
            'End If
          'Else
          '  MsgBox "There was a problem creating the user"
        End If 
    Next
    MsgBox "Done Creating " & nUsers & " Users"
    dtEnd = Now()
    nSeconds = DateDiff("s",dtStart,dtEnd)
    fUsersPerSec = CSng(nUsers / nSeconds)
    MsgBox "It Took " & DateDiff("s",dtStart,dtEnd)  & " Seconds or " & VbCrLf & _
           fUsersPerSec & " users/sec."
  Else
    MsgBox "There was a problem getting the computer"
End if

Set objComputer = Nothing