We help IT Professionals succeed at work.

I get a Runtime error for this Hta code

1,414 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

Comment
Watch Question

Top Expert 2008
Commented:
This one is on us!
(Get your first solution completely free - no credit card required)
UNLOCK SOLUTION
Unlock the solution to this question.
Join our community and discover your potential

Experts Exchange is the only place where you can interact directly with leading experts in the technology field. Become a member today and access the collective knowledge of thousands of technology experts.

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.