Solved

I get a Runtime error for this Hta code

Posted on 2008-10-03
1
1,370 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
1 Comment
 
LVL 10

Accepted Solution

by:
c0ldfyr3 earned 500 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

SharePoint Admin?

Enable Your Employees To Focus On The Core With Intuitive Onscreen Guidance That is With You At The Moment of Need.

Question has a verified solution.

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

This article will show, step by step, how to integrate R code into a R Sweave document
When we want to run, execute or repeat a statement multiple times, a loop is necessary. This article covers the two types of loops in Python: the while loop and the for loop.
The goal of the video will be to teach the user the concept of local variables and scope. An example of a locally defined variable will be given as well as an explanation of what scope is in C++. The local variable and concept of scope will be relat…
The viewer will be introduced to the member functions push_back and pop_back of the vector class. The video will teach the difference between the two as well as how to use each one along with its functionality.

734 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