Option Explicit Dim arrPasswords, strUserName strUserName = "JohnDoe" arrPasswords = IEChangePwd( strUserName ) WScript.Echo "Change password for : " & strUserName & vbCrLf _ & "The old password was : " & arrPasswords(0) & vbCrLf _ & "The new password is : " & arrPasswords(1) Function IEChangePwd( myUserName ) ' This function uses Internet Explorer to create a login dialog. ' It won't close until all fields have valid values and the OK ' button is clicked. ' ' Version: 2.11 ' Last modified: 2013-11-07 ' ' Arguments: [string] user name ' Returns: [array] the old (0) and new (1) passwords ' ' Written by Rob van der Woude ' http://www.robvanderwoude.com ' Error handling code written by Denis St-Pierre Dim arrPwd, blnValid, objIE blnValid = False ' Create an IE object Set objIE = CreateObject( "InternetExplorer.Application" ) ' specify some of the IE window's settings objIE.Navigate "about:blank" objIE.Document.title = "Change password" & String( 80, "." ) objIE.ToolBar = False objIE.Resizable = False objIE.StatusBar = False objIE.Width = 400 objIE.Height = 240 ' Center the dialog window on the screen With objIE.Document.parentWindow.screen objIE.Left = (.availWidth - objIE.Width ) \ 2 objIE.Top = (.availheight - objIE.Height) \ 2 End With ' Wait till IE is ready Do While objIE.Busy WScript.Sleep 200 Loop ' Insert the HTML code to prompt for user input objIE.Document.body.innerHTML = "
" _ & "
Change password for " _ & myUserName & ":
Old password:" _ & "
New password:" _ & "
Confirm " _ & "password:
" _ & "

" ' Hide the scrollbars objIE.Document.body.style.overflow = "auto" ' Make the window visible objIE.Visible = True ' Set focus on password input field objIE.Document.all.OldPassword.focus ' Wait for valid input (2 non-empty equal passwords) Do Until blnValid = True ' Wait till the OK button has been clicked On Error Resume Next Do While objIE.Document.all.OK.value = 0 WScript.Sleep 200 ' Error handling code by Denis St-Pierre If Err Then IEChangePwd = Array( "", "" ) objIE.Quit Set objIE = Nothing Exit Function End If Loop On Error Goto 0 ' Read the user input from the dialog window arrPwd = Array( objIE.Document.all.OldPassword.value, _ objIE.Document.all.NewPassword.value, _ objIE.Document.all.ConfirmPassword.value ) ' Check if the new password and confirmed password match If arrPwd(1) = arrPwd(2) Then ' Check if the new password isn't empty If Trim( arrPwd(1) ) = "" Then MsgBox "The new password cannot be empty", _ vbOKOnly + vbInformation + vbApplicationModal, _ "Type new password" objIE.Document.all.NewPassword.value = "" objIE.Document.all.ConfirmPassword.value = "" objIE.Document.all.OK.value = 0 objIE.Document.all.NewPassword.focus Else blnValid = True End If Else MsgBox "The new and confirmed passwords do not match.", _ vbOKOnly + vbInformation + vbApplicationModal, _ "Retype new password" objIE.Document.all.NewPassword.value = "" objIE.Document.all.ConfirmPassword.value = "" objIE.Document.all.OK.value = 0 objIE.Document.all.NewPassword.focus End If Loop ' Close and release the object objIE.Quit Set objIE = Nothing ' Return the passwords in an array IEChangePwd = Array( arrPwd(0), arrPwd(1) ) End Function