Help with VB in HTA File [Archive]

srdudley

07-01-2010, 10:05 PM

I am recieving an error of Access Denied in a HTA file when the self.ResizeTo is called in the following code on Line 59 any help would be great.

<html>

<title>Personal Folder Creator</title>

<HTA:APPLICATION
ID="objPersonalFolderCreator"
APPLICATIONNAME="PersonalFolderCreator"
WINDOWSTATE="normal"
>
<head>

<style>
BODY
{
font-family: verdana;
font-size: 8pt;
}
H2
{
color: blue;
}
.Table
{
font-size: 10pt;
border-width: thin;
border-style: solid;
padding: 10px;
}
.ResultsTable
{
border-width: thin;
border-style: solid;
font-size: 8pt;
}
</style>

'********************************************************************
'* BEGIN_SCRIPT
'********************************************************************
<script language="vbscript">
Option Explicit

Dim objShell, objFSO
Dim strServer, strPath

strServer = "TWB-FLS-PR-01"
strPath = "Personal"

Sub Window_Onload
Set objShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

ParentFolder.Disabled = True
SubmitButton.Disabled = True

PopulateParentFolders

self.Focus()
self.ResizeTo 720,410
UserID.Focus()
End Sub

Sub PopulateParentFolders
Dim objFolder, objTempFolder, strTempPath

strTempPath = "\\" & strServer & "\" & strPath
Set objFolder = objFSO.GetFolder(strTempPath)

For Each objTempFolder In objFolder.SubFolders
Dim objoption
Set objOption = Document.CreateElement("OPTION")
objOption.Text = objTempFolder.Name
objOption.Value = objTempFolder.Name
ParentFolder.Add(objOption)
Next

End Sub

Sub LookupButton_OnClick()
Dim objUser

Set objUser = GetObject("WinNT://PRDS/" & UserID.Value)
lblUserName.innerText = objUser.FullName

If InStr(lblUserName.innerText, "(") > 0 Then
lblSubFolder.innerText = Mid(lblUserName.innerText, 1, InStr(lblUserName.innerText, "(") - 1)
ElseIf InStr(lblUserName.innerText, "[") > 0 Then
lblSubFolder.innerText = Mid(lblUserName.innerText, 1, InStr(lblUserName.innerText, "[") - 1)
End If

ParentFolder.Disabled = False
SubmitButton.Disabled = False
LookupButton.Disabled = True
UserID.Disabled = True
lblStatus.innerHTML = "Select Parent Folder - DEFAULT is PERSONAL."

End Sub

Sub SubmitButton_OnClick()
Dim strCommand
Dim intReturn

If objFSO.FolderExists(lblTargetFolder.innerText) Then
MsgBox "Folder Already Exists!", vbExclamation
lblStatus.innerHTML = "<font color='red'>Folder Already Exists.</font>"
Exit Sub
Else
If MsgBox("Create the Personal Folder:" & vbNewLine & lblTargetFolder.innerText, vbYesNo + vbQuestion) = vbNo Then
Exit Sub
End If
End If

objFSO.CreateFolder(lblTargetFolder.innerText)

strCommand = "SUBINACL /file """ & lblTargetFolder.innerText & """ /perm /grant=Administrators=F /grant=SYSTEM=F /grant=PRDS\sor-A-Admins=F /grant=PRDS\" & UserID.Value & "=C /setowner=Administrators"
intReturn = objShell.Run(strCommand, 7, True)
If intReturn <> 0 Then
MsgBox "Error modifying permissions on folder: " & lblTargetFolder.innerText,vbExclamation
Else
SubmitButton.Disabled = True
ParentFolder.Disabled = True
MsgBox "Personal Folder Created and Permissions have been set accordingly." & vbNewLine & "Advise Customer the Path to their Personal Folder.", vbInformation
lblStatus.innerHTML = "<font color='green'>Folder Created Successfully.</font>"
End If

End Sub

Sub ResetButton_OnClick()
ParentFolder.Disabled = True
SubmitButton.Disabled = True
LookupButton.Disabled = False
UserID.Disabled = False
ParentFolder.Value = "NUL"
lblUserName.innerText = ""
lblSubFolder.innerText = ""
lblTargetFolder.innerText = ""
UserID.Value = ""
UserID.Focus()
lblStatus.innerHTML = "Enter User ID and Click Lookup."
End Sub

Sub ParentFolder_OnChange()
If ParentFolder.Value = "NUL" Then
lblTargetFolder.innerText = ""
lblStatus.innerHTML = "Select Parent Folder."
Else
lblTargetFolder.innerText = "\\" & strServer & "\" & strPath & "\" & ParentFolder.Value & "\" & lblSubFolder.innerText
lblStatus.innerHTML = "Ready to Create Folder."
End If
End Sub

</script>
'****************************************************************************
'* END_SCRIPT
'****************************************************************************

</head>

'****************************************************************************
'* HTML Section
'****************************************************************************

<body>
<h2 align="center">Personal Folder Creator - TWB-FLS-PR-01</h2>
<table id='tblInput' class='Table' width="670">
<tr><td><b>User ID: </b></td><td rowspan="2"><input type='text' name='UserID' size='10'><button name='LookupButton'>Lookup</button>
<p><select name='ParentFolder'><option value='NUL'>Select</option></select></td>
<td rowspan="2"> </td><td rowspan="2" width="324">
<img border="0" src="http://sor-app-pr-01:78/_layouts/images/IT_support.gif" width="324" height="103"></td></tr>
<tr><td><b>Parent Folder: </b></td></tr>
</table>

<br/>
<table id='tblSummary' class='Table' width="670">
<tr><td><b>User Name: </b></td><td><div id='lblUserName'> </div></td></tr>
<tr><td><b>Personal Folder: </b></td><td><div id='lblSubFolder'> </div></td></tr>
<tr><td width='15%'><b>Target Folder: </b></td><td width='85%'><div id='lblTargetFolder'></div></td></tr>
<tr><td><b><font color="#FF0000">Status:</font> </b></td><td><font color='red'><div id='lblStatus'>Enter User ID and Click Lookup.</div></font></td></tr>
</table>
<br/>
<div align="left">
<table id='tblButtons' class='Table' style="border-style: solid">
<tr><td>
<p align="center"><button name='SubmitButton'>
<p align="left">Create Folder</button></td><td>
<p align="center"><button name='ResetButton'>Reset</button></td><td>
<p align="center"><button name='ExitButton' onClick='self.Close()'>Exit</button></td></tr>
</table>
</div>
<br/>
Version 1.1(SOR) : Last Modified 11-08-2008 by Steve Dudley : ITO SOR
<br/>
Version 1.0 : Created on 04-01-07 by Adam Rutt : ISB DTSG
</body>

</html>