Permission denied Error 800A0046 'objIE.Document.parentWindow.screen'

I have a script that I put together for my users a few years ago to get them to share company drives after they logged in to the VPN. The script has worked well over the years with some tweaks needed here and there due to IE version update. As of today, I can no longer get the script to function normally Error:

Line:   93
Char:   5
Error:  Permission denied: 'objIE.Document.parentWindow.screen'
Code:   800A0046
Source:     Microsoft VBScript runtime error

      

I'm not sure what changed, but after a few searches on error codes and other elements, I figured I posted it here and see if any of you can help resolve this issue.

dim WshNetwork
Dim arrFileLines()

'On Error Resume Next

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("Drive Shares.txt", 1)
If Not err.number = 0 then
    WScript.Echo "Drive Shares.txt was not found.  Please ensure that it is in the same directory as this script file"
    WScript.Quit
End If

NumElements = 0
Do Until objFile.AtEndOfStream
Redim Preserve arrFileLines(NumElements)
arrFileLines(NumElements) = objFile.ReadLine
NumElements = NumElements + 1
Loop
objFile.Close

strPw = GetPassword()

If strPw = "" Then
     wScript.Quit
End If

SplitPasswd = Split(StrPW,"*",2)

username = "DEFAULT\" & SplitPasswd(0)
password = SplitPasswd(1)

Set WshNetwork = Wscript.CreateObject("WScript.Network")

For Count = 0 to (NumElements - 1)

SplitDriveInfo =  Split(arrFileLines(Count)," ",2)
DriveLetter = SplitDriveInfo(0)
Share = SplitDriveInfo(1)

ExitCode = WshNetwork.MapNetworkDrive(DriveLetter, Share, false, username, password)
ErrorHandler(err.number)

Next

Sub ErrorHandler(ErrorNumber)
    Select Case ErrorNumber

    Case 0 
        'OK
        Exit Sub

    Case -2147024811 
        'Already Mapped Continue
        Exit Sub

    Case -2147024843
        'No Connection
        WScript.Echo "No connection found.  Confirm you have an internet connection and that you have the VPN connected."
        WScript.Quit

    Case -2147024829
        'Share not available
        WScript.Echo "The drive share you are trying to connect to does not exist on this server."
        WScript.Quit

    Case -2147023570
        'Invalid username or password
        WScript.Echo "Invalid username or password.  Please try again."
        WScript.quit

    Case Else
        WScript.Echo "Unknown error: " & CStr(ErrorNumber)
        WScript.Quit

    End Select


End Sub



Function GetPassword()

    Dim objIE
    Set objIE = CreateObject( "InternetExplorer.Application" )
    objIE.Navigate "about:blank"
    objIE.Document.Title = "Login Credentials"
    objIE.ToolBar        = False
    objIE.Resizable      = False
    objIE.StatusBar      = False
    objIE.Width          = 320
    objIE.Height         = 320
    With objIE.document.parentWindow.screen
        objIE.Left = (.availwidth  - objIE.Width ) \ 2
        objIE.Top  = (.availheight - objIE.Height) \ 2
    End With

    objIE.Document.Body.InnerHTML = "<DIV align=""center""><P>Please enter your credentials</P>" & vbCrLf _
                                  & "<DIV align=""center""><P>Username</P>" & vbCrLf _                            
                                  & "<P><INPUT TYPE=""Username"" SIZE=""20"" " _
                                  & "ID=""UserName""></P>" & vbCrLf _
                                  & "<DIV align=""center""><P>Password</P>" & vbCrLf _
                                  & "<P><INPUT TYPE=""password"" SIZE=""20"" " _
                                  & "ID=""Password""></P>" & vbCrLf _
                                  & "<P><INPUT TYPE=""hidden"" ID=""OK"" " _
                                  & "NAME=""OK"" VALUE=""0"">" _
                                  & "<INPUT TYPE=""submit"" VALUE="" OK "" " _
                                  & "OnClick=""VBScript:OK.Value=1""></P></DIV>"
    objIE.Visible = True

    Do While objIE.Document.All.OK.Value = 0
        WScript.Sleep 200
    Loop

    GetPassword = objIE.Document.All.UserName.Value & "*" & objIE.Document.All.Password.Value
    objIE.Quit
    Set objIE = Nothing


End Function

      

Any help with this would be greatly appreciated.

+3


source to share


2 answers


A hotfix has been released by Microsoft: [KB3025390] http://support.microsoft.com/kb/3025390

I can confirm that removing this update will fix the problem if it works before December 17, 2014.



Please vote up if this worked.

+2


source


I had a similar problem with an HTA program using IE 11 and the With objIE.Document.ParentWindow.Screen command.

I found adding objIE.left = 910 and objIE.top and removed the section With objIE.Document.ParentWindow.Screen and now IE Windows opens fine.



Sub AdditionalComputerInfo
'v3.00 - Changed to HTML Output
strComputer = trim(txtComputerName.Value)
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
objIE.ToolBar = 0
objIE.StatusBar = 0
objIE.addressbar = 0
objIE.Width = 650
objIE.Height = 900
'added v3.02
objIE.Left = 910
objIE.Top  = 20
objIE.Document.Title = " " & uCase(strComputer) & " Information"
'With objIE.Document.ParentWindow.Screen removed in version 3.02
'   objIE.Left = 910 
'    objIE.Top  = 20 
'End With
Set objDoc = objIE.Document.Body

      

0


source







All Articles