Solved

I get a Runtime error for this Hta code

Posted on 2008-10-03
1
1,363 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 500 total points
Comment Utility
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

Do You Know the 4 Main Threat Actor Types?

Do you know the main threat actor types? Most attackers fall into one of four categories, each with their own favored tactics, techniques, and procedures.

Join & Write a Comment

This article is meant to give a basic understanding of how to use R Sweave as a way to merge LaTeX and R code seamlessly into one presentable document.
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
The goal of the video will be to teach the user the difference and consequence of passing data by value vs passing data by reference in C++. An example of passing data by value as well as an example of passing data by reference will be be given. Bot…
The viewer will learn additional member functions of the vector class. Specifically, the capacity and swap member functions will be introduced.

728 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

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now