asked on
I get a Runtime error for this Hta code

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
ASKER CERTIFIED SOLUTION
c0ldfyr3
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial