Option Explicit
Dim strUser, rootDSE, adoConnection, ldapStr, adoRecord, objUser, strExt, objExt, strMsg, choice

' Change the attribute in the 4 numbered locations and save as new VBS.

struser = WScript.Arguments(0)

Set rootDSE = GetObject("LDAP://RootDSE")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADSDSOObject"
adoConnection.Open "ADs Provider"

ldapStr = "<LDAP://" & rootDSE.Get("defaultNamingContext") & ">;(&(objectCategory=Person)(objectClass=User)(samAccountName=" & strUser & "));adspath;subtree"

Set adoRecord = adoConnection.Execute(ldapStr)
Set objUser = GetObject (adoRecord.Fields(0).Value)

' 1

strMsg = "The current extension is: " & objUser.telephoneNumber & VbCrLf & VbCrLf & _
    "Do you want to change this user's extension in AD?"

choice = MsgBox(strMsg,4,"Change Extension?")

If choice = 6 Then

' 2

strExt = Inputbox("Enter Extension:","Enter Extension",objUser.telephoneNumber)

If Not adoRecord.EOF Then
    On Error Resume Next

' 3
        objUser.Put "telephoneNumber", "" & strExt
        objUser.SetInfo
    On Error GoTo 0
End If

End If

'Set objExt = GetObject("LDAP://" & objUser.distinguishedName)

' 4

MsgBox "Extension: " & objUser.telephoneNumber,0,"User's Extension"