Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

I get a Runtime error for this Hta code

Posted on 2008-10-03
1
Medium Priority
?
1,378 Views
Last Modified: 2009-07-29
Hi,

I got this code while googling. Which seemed to suit my requirment. can anyone help me with getting this done. I get the below error.

---------------------------
Error
---------------------------
A Runtime Error has occurred.
Do you wish to Debug?

Line: 21
Error: Unterminated string constant
---------------------------
Yes   No  
---------------------------

What are all the lines i need to change.

REgards
Sharath
<html>
<head>
<title>Authentication</title>
<HTA:APPLICATION
ID="objMailboxReport"
APPLICATIONNAME="MailboxReport"
SCROLL="no"
SINGLEINSTANCE="yes"
WINDOWSTATE="normal"
>
</head>
<style>
BODY{background-color: buttonface; font-family: Helvetica; font-size: 10;}
.button{font-family: arial; font-size: 10pt;}
</style>
<SCRIPT Language="VBScript">
i=0
Sub Window_Onload
self.ResizeTo 210,200
strHTML = strHTML & "<font style=""button"">"
strHTML = strHTML & "<b>Enter your authentication credentials</b><hr>"
strHTML = strHTML & "Domain:&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input
type=""text"" name=""DomainNameBox"" size=""15""><br>User Name: <input
type=""text"" name=""UserNameBox""
size=""15""><br>Password:&nbsp;&nbsp;&nbsp; <input type=""password""
name=""PasswordArea"" size=""15"">"
strHTML = strHTML & "<input id=runbutton class=""button"" type=""button""
value=""Submit"" name=""run_button"" onClick=""RunScript"">"
Authentication.InnerHTML = strHTML
End Sub
Sub RunScript
ConfirmRun = MsgBox ("This process will search through all the Exchange
Servers in order" & VbCrLf _
& "to enumerate mailboxes and their sizes in addition to querying
AD" & VbCrLf _
& "using RootDSE to enumerate mailbox limit attributes. This
process" & VbCrLf _
& "will take a long time to complete and will consume a portion
of local" & VbCrLf _
& "resources during processing. Are you sure you wish to
continue?", _
68, "Run Mailbox Size and Quota Report")
If ConfirmRun = 6 Then
On Error Resume Next
'-- Check to see if Excel is installed.
Set objExcel = CreateObject("Excel.Application")
If Err.Number <> 0 Then
On Error GoTo 0
WScript.Echo "Excel application not found."
WScript.Quit
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
objName = objFSO.GetTempName
objTempFile = objName
Set outfile = objFSO.OpenTextFile(objTempFile, 2, True)
objExcel.Workbooks.Add
'-- Format the spreadsheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Range("A1:C10000").Font.Size = 8
objSheet.Range("A1:C1").Font.Bold = True
objSheet.Name = "MBX Size"
ObjSheet.Columns(1).Columnwidth = 20
ObjSheet.Columns(2).Columnwidth = 14
ObjSheet.Columns(3).Columnwidth = 8
intRow = 2
intCola = 1
intColb = 2
intColc = 3
intCold = 4
intCole = 5
objSheet.Cells(1, 1).Value = "MailboxDisplayName"
objSheet.Cells(1, 2).Value = "ServerName"
objSheet.Cells(1, 3).Value = "Size(KB)"
strExcelPath = "C:\temp\Mailbox_Quota.xls"
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
g=0
'-- Edit this line to change servers queried.
arrComputers = Array("server1","server2")
'-- Edit this line to reflect the domain where the mail server reside.
strDomain = "Domainname"
strCount = UBound(arrComputers)
'-- Query the Exchange servers in the array.
For Each strComputer In arrComputers
strCountA = strCount-1
Set objCompName = GetObject("WinNT://" & strDomain & "/" & strComputer)
Set progBar = CreateObject("internetexplorer.application")
progBar.navigate2 "about :blank" : progBar.width = 350 : progBar.height =
120 : progBar.toolbar = false : progBar.menubar = False : progBar.statusbar
= False : progBar.visible = True
progBar.document.write "<font color=blue>"
progBar.document.write "Querying data from " & objCompName.Name & "<br>
(" & strCountA & " remaining)"
progBar.document.title = "Current Progress..."
Set SWbemLocator = CreateObject("WbemScripting.SWBemlocator")
Set objWMIService = SWBemlocator.ConnectServer _
(strComputer, "root\MicrosoftExchangeV2", _
DomainNameBox.Value & "\" & UserNameBox.Value, PasswordArea.Value)
Set colItems = objWMIService.ExecQuery("SELECT * FROM Exchange_Mailbox",
"WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
outfile.writeline objItem.MailboxDisplayName
objSheet.Cells(intRow, intCola).Value = objItem.MailboxDisplayName
objSheet.Cells(intRow, intColb).Value = objItem.ServerName
objSheet.Cells(intRow, intColc).Value = objItem.Size
intRow = intRow+1
g=g+1
Next
progBar.quit
Next
outfile.close
intRow=2
n1 = g/100
nA = Round(n1, 0)
n = 0
'-- Format the second worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(2)
Set infile = objFSO.OpenTextFile(objTempFile)
Set progBar = CreateObject("internetexplorer.application")
progBar.navigate2 "about :blank" : progBar.width = 350 : progBar.height =
80 : progBar.toolbar = false : progBar.menubar = False : progBar.statusbar =
False : progBar.visible = True
objSheet.Range("A1:E10000").Font.Size = 8
objSheet.Range("A1:E1").Font.Bold = True
objSheet.Name = "MBX Quota"
ObjSheet.Columns(1).Columnwidth = 20
ObjSheet.Columns(2).Columnwidth = 20
ObjSheet.Columns(3).Columnwidth = 17
ObjSheet.Columns(4).Columnwidth = 16
ObjSheet.Columns(5).Columnwidth = 27
objSheet.Range("C2:C10000").HorizontalAlignment = -4108
objSheet.Range("D2:D10000").HorizontalAlignment = -4108
objSheet.Range("E2:E10000").HorizontalAlignment = -4108
objSheet.Cells(1, 1).Value = "Display Name"
objSheet.Cells(1, 2).Value = "Use MBX Store Defaults"
objSheet.Cells(1, 3).Value = "Issue Warning (KB)"
objSheet.Cells(1, 4).Value = "Prohibit Send (KB)"
objSheet.Cells(1, 5).Value = "Prohibit Send and Recieve (KB)"
'-- Query AD for mailbox limit information.
Do While infile.AtEndOfStream <> True
strLine = infile.ReadLine
If n > nA Then
progBar.document.write "<font color=blue>"
progBar.document.write "|"
progBar.document.title = "Enumerating Acct Info..."
n=0
End If
arrdisplayName = Split(strLine, VbCrLf)
strdisplayName = arrdisplayName(0)
Set objRootDSE = GetObject("LDAP://rootDSE")
strADsPath = "LDAP://" & objRootDSE.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objCommand.CommandText = "SELECT
distinguishedName,displayName,mDBStorage
Quota,mDBOverQuotaLimit,mDBOverHardQuota
Limit
FROM 'LDAP://dc=dems,dc=mil,dc=ca' WHERE displayName = '" & strdisplayName &
"'"
objCommand.Properties("Page Size")= 1000
Set objRecordSet = objCommand.Execute
While Not objRecordset.EOF
strADSPathA = objRecordset.Fields("distinguishedName")
Set oUser = GetObject("LDAP://" & strADSPathA)
objSheet.Cells(intRow, intCola).Value = oUser.displayName
objSheet.Cells(intRow, intColb).Value = oUser.mDBUseDefaults
objSheet.Cells(intRow, intColc).Value = oUser.mDBStorageQuota
objSheet.Cells(intRow, intCold).Value = oUser.mDBOverQuotaLimit
objSheet.Cells(intRow, intCole).Value = oUser.mDBOverHardQuotaLimit
intRow = intRow+1
objRecordset.MoveNext
Wend
n=n+1
Loop
progBar.quit
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
infile.Close
objFSO.DeleteFile(objTempFile)
MsgBox "Report is located at C:\temp\Mailbox_quota.xls", "Report
Completed"
'-- Clean up.
Set objRootDSE = Nothing
Set objConnection = Nothing
Set objCommand = Nothing
Set objFSO = Nothing
Else
window.close()
End If
window.close()
End Sub
</SCRIPT>
<body>
<span id="Authentication"></span>
</body>
</html>

Open in new window

0
Comment
Question by:bsharath
1 Comment
 
LVL 10

Accepted Solution

by:
c0ldfyr3 earned 2000 total points
ID: 22632470
This should do it.

I assume you copied this directly from a text input which had wrapping so it wrapped some lines which you cannot do in VBS/HTA

<html>
<head>
<title>Authentication</title>
<HTA:APPLICATION
ID="objMailboxReport"
APPLICATIONNAME="MailboxReport"
SCROLL="no"
SINGLEINSTANCE="yes"
WINDOWSTATE="normal"
>
</head>
<style>
BODY{background-color: buttonface; font-family: Helvetica; font-size: 10;}
.button{font-family: arial; font-size: 10pt;}
</style>
<SCRIPT Language="VBScript">
i=0
Sub Window_Onload
self.ResizeTo 210,200
strHTML = strHTML & "<font style=""button"">"
strHTML = strHTML & "<b>Enter your authentication credentials</b><hr>"
strHTML = strHTML & "Domain:      <input"
strHTML = strHTML & "type=""text"" name=""DomainNameBox"" size=""15""><br>User Name: <input"
strHTML = strHTML & "type=""text"" name=""UserNameBox"""
strHTML = strHTML & "size=""15""><br>Password:    <input type=""password"""
strHTML = strHTML & "name=""PasswordArea"" size=""15"">"
strHTML = strHTML & "<input id=runbutton class=""button"" type=""button"""
strHTML = strHTML & "value=""Submit"" name=""run_button"" onClick=""RunScript"">"
Authentication.InnerHTML = strHTML
End Sub
Sub RunScript
ConfirmRun = MsgBox ("This process will search through all the Exchange Servers in order" & VbCrLf _
& "to enumerate mailboxes and their sizes in addition to querying AD" & VbCrLf _
& "using RootDSE to enumerate mailbox limit attributes. This process" & VbCrLf _
& "will take a long time to complete and will consume a portion of local" & VbCrLf _
& "resources during processing. Are you sure you wish to continue?", _
68, "Run Mailbox Size and Quota Report")
If ConfirmRun = 6 Then
On Error Resume Next
'-- Check to see if Excel is installed.
Set objExcel = CreateObject("Excel.Application")
If Err.Number <> 0 Then
On Error GoTo 0
WScript.Echo "Excel application not found."
WScript.Quit
End If
Set objFSO = CreateObject("Scripting.FileSystemObject")
objName = objFSO.GetTempName
objTempFile = objName
Set outfile = objFSO.OpenTextFile(objTempFile, 2, True)
objExcel.Workbooks.Add
'-- Format the spreadsheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Range("A1:C10000").Font.Size = 8
objSheet.Range("A1:C1").Font.Bold = True
objSheet.Name = "MBX Size"
ObjSheet.Columns(1).Columnwidth = 20
ObjSheet.Columns(2).Columnwidth = 14
ObjSheet.Columns(3).Columnwidth = 8
intRow = 2
intCola = 1
intColb = 2
intColc = 3
intCold = 4
intCole = 5
objSheet.Cells(1, 1).Value = "MailboxDisplayName"
objSheet.Cells(1, 2).Value = "ServerName"
objSheet.Cells(1, 3).Value = "Size(KB)"
strExcelPath = "C:\temp\Mailbox_Quota.xls"
Const wbemFlagReturnImmediately = &h10
Const wbemFlagForwardOnly = &h20
g=0
'-- Edit this line to change servers queried.
arrComputers = Array("server1","server2")
'-- Edit this line to reflect the domain where the mail server reside.
strDomain = "Domainname"
strCount = UBound(arrComputers)
'-- Query the Exchange servers in the array.
For Each strComputer In arrComputers
strCountA = strCount-1
Set objCompName = GetObject("WinNT://" & strDomain & "/" & strComputer)
Set progBar = CreateObject("internetexplorer.application")
progBar.navigate2 "about :blank"
progBar.width = 350 
progBar.height = 120 : progBar.toolbar = false : progBar.menubar = False 
progBar.statusbar = False : progBar.visible = True
progBar.document.write "<font color=blue>"
progBar.document.write "Querying data from " & objCompName.Name & "<br>(" & strCountA & " remaining)"
progBar.document.title = "Current Progress..."
Set SWbemLocator = CreateObject("WbemScripting.SWBemlocator")
Set objWMIService = SWBemlocator.ConnectServer _
(strComputer, "root\MicrosoftExchangeV2", _
DomainNameBox.Value & "\" & UserNameBox.Value, PasswordArea.Value)
Set colItems = objWMIService.ExecQuery("SELECT * FROM Exchange_Mailbox", "WQL", _
wbemFlagReturnImmediately + wbemFlagForwardOnly)
For Each objItem In colItems
outfile.writeline objItem.MailboxDisplayName
objSheet.Cells(intRow, intCola).Value = objItem.MailboxDisplayName
objSheet.Cells(intRow, intColb).Value = objItem.ServerName
objSheet.Cells(intRow, intColc).Value = objItem.Size
intRow = intRow+1
g=g+1
Next
progBar.quit
Next
outfile.close
intRow=2
n1 = g/100
nA = Round(n1, 0)
n = 0
'-- Format the second worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(2)
Set infile = objFSO.OpenTextFile(objTempFile)
Set progBar = CreateObject("internetexplorer.application")
progBar.navigate2 "about :blank" : progBar.width = 350
progBar.height = 80 : progBar.toolbar = false : progBar.menubar = False
progBar.statusbar = False : progBar.visible = True
objSheet.Range("A1:E10000").Font.Size = 8
objSheet.Range("A1:E1").Font.Bold = True
objSheet.Name = "MBX Quota"
ObjSheet.Columns(1).Columnwidth = 20
ObjSheet.Columns(2).Columnwidth = 20
ObjSheet.Columns(3).Columnwidth = 17
ObjSheet.Columns(4).Columnwidth = 16
ObjSheet.Columns(5).Columnwidth = 27
objSheet.Range("C2:C10000").HorizontalAlignment = -4108
objSheet.Range("D2:D10000").HorizontalAlignment = -4108
objSheet.Range("E2:E10000").HorizontalAlignment = -4108
objSheet.Cells(1, 1).Value = "Display Name"
objSheet.Cells(1, 2).Value = "Use MBX Store Defaults"
objSheet.Cells(1, 3).Value = "Issue Warning (KB)"
objSheet.Cells(1, 4).Value = "Prohibit Send (KB)"
objSheet.Cells(1, 5).Value = "Prohibit Send and Recieve (KB)"
'-- Query AD for mailbox limit information.
Do While infile.AtEndOfStream <> True
strLine = infile.ReadLine
If n > nA Then
progBar.document.write "<font color=blue>"
progBar.document.write "|"
progBar.document.title = "Enumerating Acct Info..."
n=0
End If
arrdisplayName = Split(strLine, VbCrLf)
strdisplayName = arrdisplayName(0)
Set objRootDSE = GetObject("LDAP://rootDSE")
strADsPath = "LDAP://" & objRootDSE.Get("defaultNamingContext")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objCommand.CommandText = "SELECT distinguishedName,displayName,mDBStorage Quota,mDBOverQuotaLimit,mDBOverHardQuota Limit FROM 'LDAP://dc=dems,dc=mil,dc=ca' WHERE displayName = '" & strdisplayName & "'"
objCommand.Properties("Page Size")= 1000
Set objRecordSet = objCommand.Execute
While Not objRecordset.EOF
strADSPathA = objRecordset.Fields("distinguishedName")
Set oUser = GetObject("LDAP://" & strADSPathA)
objSheet.Cells(intRow, intCola).Value = oUser.displayName
objSheet.Cells(intRow, intColb).Value = oUser.mDBUseDefaults
objSheet.Cells(intRow, intColc).Value = oUser.mDBStorageQuota
objSheet.Cells(intRow, intCold).Value = oUser.mDBOverQuotaLimit
objSheet.Cells(intRow, intCole).Value = oUser.mDBOverHardQuotaLimit
intRow = intRow+1
objRecordset.MoveNext
Wend
n=n+1
Loop
progBar.quit
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
infile.Close
objFSO.DeleteFile(objTempFile)
MsgBox "Report is located at C:\temp\Mailbox_quota.xls", "Report Completed"
'-- Clean up.
Set objRootDSE = Nothing
Set objConnection = Nothing
Set objCommand = Nothing
Set objFSO = Nothing
Else
window.close()
End If
window.close()
End Sub
</SCRIPT>
<body>
<span id="Authentication"></span>
</body>
</html>

Open in new window

0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The purpose of this article is to demonstrate how we can use conditional statements using Python.
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
This tutorial explains how to use the VisualVM tool for the Java platform application. This video goes into detail on the Threads, Sampler, and Profiler tabs.
This video will show you how to get GIT to work in Eclipse.   It will walk you through how to install the EGit plugin in eclipse and how to checkout an existing repository.
Suggested Courses

971 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question