Solved

Microsoft VBScript runtime error 424

Posted on 2007-12-04
5
8,261 Views
Last Modified: 2008-02-01
Having a hard time finding the line causing this error: Microsoft VBScript runtime error, 424 Object required.
On Error Resume Next

'*******************************************************************************************

'set constants: This section contains the constants like username, diagramname etc which

'               will be used by the script.

 

'declare constants

Dim username, userpassword

Dim diagramName

Dim reportPath

Dim fieldStatusColumn 'column from which "Field Status" gets printed

Dim curRow, curCol

Dim startTime, finishTime

startTime = Now()

 

'Create Email Message

Dim objMessage

Set objMessage = CreateObject("CDO.Message") 

If Err.number <> 0 then

	WScript.Quit Err.Number

End If 

 

objMessage.Sender = "fakeemail@domain.zzz" 

objMessage.From = "Dee Script"

objMessage.To = "fakeemail@domain.zzz;"

objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "mail.domain.zzz" 

objMessage.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

objMessage.Configuration.Fields.Update

 

 

'******************************************************************

'The users can modify these parameters as per their environment.

'Configuration Parameters

'*************************

'define constants

'Name of the model file from which report has to be generated

diagramName = "Mike_Test.dm1"

'Path to where the output should be written to

reportPath = "D:\ERStudioTemp\Data Model Reports\Mike_Test\Data Dictionary Reports\"

'******************************************************************

 

 

fieldStatusColumn = 7

 

'Excel constants

Dim xlLastCell, xlAscending, xlCenter, xlLeft, xlGuess, xlTopToBottom, xlSortNormal, xlSolid, xlRight, xlLandscape

Dim xlPaper11x17, xlPrintErrorsDisplayed, xlDownThenOver, xlAutomatic, xlPrintNoComments

xlLastCell = 11 

xlAscending = 1

xlCenter = -4108

xlLeft = -4131

xlGuess=0

xlTopToBottom=1

xlSortNormal=0

xlSolid=1

xlRight=-4152

xlLandscape=2

xlPaper11x17=17

xlAutomatic=-4105

xlDownThenOver=1

xlPrintNoComments = -4142

xlPrintErrorsDisplayed = 0

 

Dim diagram 'Diagram object

Dim erStudioApp 'ERStudio Application Object

Dim entityList 'Collection Object for holding the list of entities

Dim entity 'Object for holding an entity

Dim viewList 'Collection object for holding all the views in the model.

Dim fso 'file system object for accessing the file system

Dim excelApp 'MS Excel Application Object

Dim mdl

Dim args ' to capture commandline arguments

Dim c ' counter

'*******************************************************************************************

 

'start erstudio application

Set erStudioApp = CreateObject("ERStudio.Application")

'erStudioApp.HideWindow

 

'open diagram from folder

erStudioApp.OpenFile("D:\Documents and Settings\SingleM\My Documents\ERStudio7.5\" & diagramName)

Set diagram = erStudioApp.ActiveDiagram

Set mdl = diagram.Models.Item("Logical")

Set viewList = (diagram.Models.Item("Logical")).Views

 

'start the word application object

Set excelApp = CreateObject("Excel.Application")

excelApp.Visible = True

 

 

Set args = WScript.Arguments

 

if (args.Count = 0) then

	'generate report for all the EDDs

	for each view in viewList

		if (InStr(view.Name, "_Main") <> 0) then

			PrintViewReport view

		end if

	next

else

	'generate report only for those EDDs which are specified in the command line

	for c = 0 to (args.Count - 1)

		if (InStr((viewList.Item(args(c))).Name, "_Main") <> 0) then

			PrintViewReport viewList.Item(args(c))

		else

			MsgBox "DD does not exist: " & args(c)

		end if

	next

end if

 

 

'close excel

excelApp.Workbooks.Close

excelApp.Quit

Set excelApp = Nothing

 

'closing the ER Studio Application

'erStudioApp.RepoLogout

'erStudioApp.Quit

Set erStudioApp= Nothing

 

If Err.Number <> 0 Then

	objMessage.Subject = "ERS -- SAP_PROD DD Excel Reports Failed to Generate"

	objMessage.TextBody = "The SAP_PROD DD Excel Reports have not been generated or published." & vbcrlf & vbcrlf & "Error Number      : " & Err.Number & vbCrlf & "Error Source       : " & Err.Source & vbCrLf & "Error Description : " & Err.Description

	objMessage.Send

	WScript.Quit

End If

 

finishTime = Now()

objMessage.Subject = "ERS -- SAP_PROD DD Excel Reports Successfully Generated" 

objMessage.TextBody = "The SAP_PROD DD Excel Reports have been generated" & vbcrlf & vbcrlf & "The script started on: " & startTime & vbcrlf & "The script completed on: " & finishTime

objMessage.Send

 

WScript.Quit

 

 

'*******************************************************************************************

'prepare the dumpFiles and report directories

Sub CleanUpFiles

	Set fso = CreateObject("Scripting.FileSystemObject")

	fso.DeleteFile reportPath & "*", True

	Set fso=Nothing

End Sub

 

'*******************************************************************************************

 

Sub PrintViewReport(view)

 

	Dim pName

	Dim vFld

	

	Dim pEntName

	Dim pAttrName

	Dim pEnt

	Dim pAttr

 

	Dim pViewFldName

	Dim pViewName

	Dim pView

	Dim pViewFld

 

	Dim gpAttrName

	Dim gpEntName

	Dim gpEnt

	Dim gpAttr

	

	Dim ddName

	Dim colName

	Dim myArray

	

	if (view.ViewFields.Count = 0) then

		exit sub

	end if

 

	excelApp.Workbooks.Add

	excelApp.ActiveWorkbook.Worksheets.Add , , 1

	

	excelApp.Worksheets(1).Name = "Dump"	

	excelApp.Worksheets(2).Name = "Data Dictionary"	

 

 

	With excelApp

		.Worksheets("Dump").Select

		.Columns("K:K").Select

		.Selection.NumberFormat="@"

		.ActiveSheet.Range("A1").Select

		.Worksheets("Data Dictionary").Select

		.Columns("H:H").Select

		.Selection.NumberFormat="@"

		.ActiveSheet.Range("A1").Select

	End With

 

 

	'create the dump worksheet

	excelApp.Worksheets("Dump").Select

 

 

	curRow = 1

 

	For Each vFld In view.ViewFields

		pName = vFld.ParentName

		

		if (mdl.Views.Item(pName) Is Nothing) then

 

			pAttrName = vFld.ParentColumnName

			pEntName = pName

			Set pEnt = mdl.Entities.Item(pEntName)

			Set pAttr = pEnt.Attributes.Item(pAttrName)

 

 

			curCol = 1

			PrintCell vFld.Alias, curRow, curCol, 0, 1

			PrintCell "Initial Screen", curRow, curCol, 0, 1

			PrintCell "0", curRow, curCol, 0, 1

			PrintCell vFld.SequenceNumber, curRow, curCol, 0, 1

			PrintCell pEntName, curRow, curCol, 0, 1

			colName = pAttr.ColumnName

			myArray = Split(colName, "-")

			colName = myArray(0)

			PrintCell colName, curRow, curCol, 0, 1			

			'PrintCell pAttr.ColumnName, curRow, curCol, 0, 1

			PrintCell pAttrName, curRow, curCol, 0, 1

			PrintCell pAttr.Definition, curRow, curCol, 0, 1

			PrintCell pAttr.Datatype, curRow, curCol, 0, 1

			

			

			Select Case pAttr.Datatype

				Case "DATE":

					PrintCell "", curRow, curCol, 0, 1

				Case "DECIMAL":

					PrintCell pAttr.DataLength & "," & pAttr.Datascale, curRow, curCol, 0, 1

				Case Else

					PrintCell pAttr.DataLength, curRow, curCol, 0, 1

			End Select

			

			

			

			If (pAttr.BoundAttachments.Item("Data Format Standard") Is Nothing) Then

				PrintCell "", curRow, curCol, 0, 1

			Else

				PrintCell pAttr.BoundAttachments.Item("Data Format Standard").ValueCurrent, curRow, curCol, 0, 1

			End If

			

			If (pAttr.BoundAttachments.Item("Field Use Status") Is Nothing) Then			

				If (pAttr.NullOption = "NULL") then

					PrintCell "O", curRow, curCol, 0, 1

				Else

					PrintCell "M", curRow, curCol, 0, 1

				End if

			Else

				PrintCell pAttr.BoundAttachments.Item("Field Use Status").ValueCurrent, curRow, curCol, 0, 1

			End If

			

			If (pAttr.BoundAttachments.Item("Business Rule") Is Nothing) Then

				PrintCell "", curRow, curCol, 0, 1

			Else

				PrintCell pAttr.BoundAttachments.Item("Business Rule").ValueCurrent, curRow, curCol, 0, 1

			End If

			PrintCell pAttr.Notes, curRow, curCol, 1, 1

			

		else

 

			pViewFldName = vFld.ParentColumnName

			pViewName = vFld.ParentName

			Set pView = mdl.Views.Item(pViewName)

			Set pViewFld = pView.ViewFields.Item(pViewFldName)

 

			gpAttrName = pViewFld.ParentColumnName

			gpEntName = pViewFld.ParentName

			Set gpEnt = mdl.Entities.Item(gpEntName)

			Set gpAttr = gpEnt.Attributes.Item(gpAttrName)

 

			curCol = 1

			PrintCell vFld.Alias, curRow, curCol, 0, 1

			PrintCell pViewName, curRow, curCol, 0, 1

			PrintCell pView.BoundAttachments.Item("Sequence Number").ValueCurrent, curRow, curCol, 0, 1

			PrintCell pViewFld.SequenceNumber, curRow, curCol, 0, 1			

			PrintCell gpEntName, curRow, curCol, 0, 1

			colName = gpAttr.ColumnName

			myArray = Split(colName, "-")

			colName = myArray(0)

			PrintCell colName, curRow, curCol, 0, 1			

			'PrintCell gpAttr.ColumnName, curRow, curCol, 0, 1

			PrintCell gpAttrName, curRow, curCol, 0, 1

			PrintCell gpAttr.Definition, curRow, curCol, 0, 1

			PrintCell gpAttr.Datatype, curRow, curCol, 0, 1

			

			

			Select Case gpAttr.Datatype

				Case "DATE":

					PrintCell "", curRow, curCol, 0, 1

				Case "DECIMAL":

					PrintCell gpAttr.DataLength & "," & gpAttr.Datascale, curRow, curCol, 0, 1

				Case Else

					PrintCell gpAttr.DataLength, curRow, curCol, 0, 1

			End Select

 

			If (gpAttr.BoundAttachments.Item("Data Format Standard") Is Nothing) Then

				PrintCell "", curRow, curCol, 0, 1

			Else

				PrintCell gpAttr.BoundAttachments.Item("Data Format Standard").ValueCurrent, curRow, curCol, 0, 1

			End If

			

			

			If (gpAttr.BoundAttachments.Item("Field Use Status") Is Nothing) Then			

				If (gpAttr.NullOption = "NULL") then

					PrintCell "O", curRow, curCol, 0, 1

				Else

					PrintCell "M", curRow, curCol, 0, 1

				End if

			Else

				PrintCell gpAttr.BoundAttachments.Item("Field Use Status").ValueCurrent, curRow, curCol, 0, 1

			End If

			

			

			If (gpAttr.BoundAttachments.Item("Business Rule") Is Nothing) Then

				PrintCell "", curRow, curCol, 0, 1

			Else

				PrintCell gpAttr.BoundAttachments.Item("Business Rule").ValueCurrent, curRow, curCol, 0, 1

			End If

			PrintCell gpAttr.Notes, curRow, curCol, 1, 1

		End if

	Next

	

	ddName = Left(view.Name, InStr(view.Name, "_") - 1)

	

	

	'Formatting the report

	FormatReport ddName

	With excelApp

		.Worksheets("Data Dictionary").Select

		.ActiveWindow.Zoom = 75

		.ActiveSheet.UsedRange.Select

		With .Selection

			.ShrinkToFit = False

			.WrapText = True

			.VerticalAlignment = 1	

		End With

		'.ActiveSheet.Range("A2")

		'.Selection.Wrap = False

	End With

	

	With excelApp

		.Worksheets("Data Dictionary").Select

		

		With .ActiveSheet.PageSetup

			.PrintTitleRows = "$1:$3"

			.LeftHeader = ""

        	.CenterHeader = "SAP Data Dictionary"

        	.RightHeader = ""

        	.LeftFooter = "&Z&F"

        	.CenterFooter = "Page &P of &N"

        	.RightFooter = "&D"

        	.LeftMargin = excelApp.InchesToPoints(0.75)

        	.RightMargin = excelApp.InchesToPoints(0.75)

       		.TopMargin = excelApp.InchesToPoints(0.75)

        	.BottomMargin = excelApp.InchesToPoints(0.75)

        	.HeaderMargin = excelApp.InchesToPoints(0.5)

        	.FooterMargin = excelApp.InchesToPoints(0.5)

        	.PrintHeadings = False

       	 	.PrintGridlines = True

        	.PrintComments = xlPrintNoComments

        	.PrintQuality = 600

        	.CenterHorizontally = False

        	.CenterVertically = False

        	.Orientation = xlLandscape

        	.Draft = False

        	.PaperSize = xlPaper11x17

        	.FirstPageNumber = xlAutomatic

        	.Order = xlDownThenOver

        	.BlackAndWhite = False

        	.Zoom = False

        	.FitToPagesWide = 1

        	.FitToPagesTall = False

        	.PrintErrors = xlPrintErrorsDisplayed

 

		End With

	End With

	

	With excelApp

		.Worksheets("Data Dictionary").Select

		.Range("A3:K3").Select

		.Selection.AutoFilter

		.Range("A1").Select

	End With

			

	

   

	'delete the dump worksheet

	DeleteSheets

	'save the report and close the workbook

	excelApp.DisplayAlerts = True

	excelApp.Worksheets("Data Dictionary").SaveAs reportPath & Replace(ddName, " ", "") & "DataDictionary.xls"

	excelApp.WorkBooks.Close

	excelApp.DisplayAlerts = true

 

End Sub

'*******************************************************************************************

Sub FormatReport (ddName)

    SortDump 

    PrintColumnHeader ddName

    PrintColumns

End Sub

'*******************************************************************************************

Sub SortDump

		

	excelApp.Workbooks(1).Sheets(1).UsedRange.Sort excelApp.Range("C1"), 1, excelApp.Range("D1"), , 1, , , , , , 1

	

End Sub

'*******************************************************************************************

'print the column header for the report

Sub PrintColumnHeader(ddName)

	With excelApp

	    .Worksheets("Data Dictionary").Select

		.Cells(1, 1).Select

		.ActiveCell.FormulaR1C1 = "SAP Data Dictionary"

		.Range("B1").Select

		.ActiveCell.FormulaR1C1 = ddName

		.Range("A1:B1").Font.Bold = True

 

' Needed while in transition from ECC6.0 to EBS, Once EBS goes live this can come out.

		'.Range("A2").Select

		'.ActiveCell.FormulaR1C1 = "Note: Dictionaries that are part of the EBS Release will not reflect ECC 6.0 upgrade.  EBS dictionaries can be found at"

		'.Range("E2").Select

   		'.ActiveSheet.Hyperlinks.Add Anchor:=Cells("E2"), Address:="\\sapguip1", TextToDisplay:="SaPGup1"

 

		.Range("A3").Select

		.ActiveCell.FormulaR1C1 = "Screen Name"

		.ActiveCell.EntireColumn.ColumnWidth = 30		

		.Range("B3").Select

		.ActiveCell.FormulaR1C1 = "Entity Name"

		.ActiveCell.EntireColumn.ColumnWidth = 30

		.Range("C3").Select

		.ActiveCell.FormulaR1C1 = "Data Element Name"

		.ActiveCell.EntireColumn.ColumnWidth = 20

		.Range("D3").Select

		.ActiveCell.FormulaR1C1 = "Field Description"

		.ActiveCell.EntireColumn.ColumnWidth = 30

		.Range("E3").Select

		.ActiveCell.FormulaR1C1 = "Definition"

		.ActiveCell.EntireColumn.ColumnWidth = 40

		.Range("F3").Select

		.ActiveCell.FormulaR1C1 = "Data Type"

		.ActiveCell.EntireColumn.ColumnWidth = 14

		.Range("G3").Select

		.ActiveCell.FormulaR1C1 = "Data Length"

		.ActiveCell.EntireColumn.ColumnWidth = 14

		.Range("H3").Select

		.ActiveCell.FormulaR1C1 = "Data Format"

		.ActiveCell.EntireColumn.ColumnWidth = 14

		.Range("I3").Select

		.ActiveCell.FormulaR1C1 = "Field Status"

		.ActiveCell.EntireColumn.ColumnWidth = 14

		.Range("J3").Select

		.ActiveCell.FormulaR1C1 = "Data  Rules"

		.ActiveCell.EntireColumn.ColumnWidth = 40

		.Range("K3").Select

		.ActiveCell.FormulaR1C1 = "Remarks"

		.ActiveCell.EntireColumn.ColumnWidth = 40

		.Range("A3:K3").Select

    .Selection.Interior.ColorIndex = 36    

		.Selection.Font.Bold = True				

	End With

End Sub

'*******************************************************************************************

Sub PrintColumns

	Dim numRows

	Dim curRow, curCol

	Dim j, k

	Dim curScreenName, prevScreenName

	curScreenName = prevScreenName = ""

	

 

	With excelApp

		numRows = .Worksheets("Dump").UsedRange.Rows.Count

		curRow = 4

 

		For j = 1 To numRows

			curScreenName = .Worksheets("Dump").Cells(j, 2).Value

        

			

			If (curScreenName <> prevScreenName) Then

				PrintScreenName .Worksheets("Dump").Cells(j, 2).Value, curRow, 0

				curRow = curRow + 1

			End If

 

			'Screen Name

			.Worksheets("Data Dictionary").Cells(curRow, 1).Value = .Worksheets("Dump").Cells(j, 2).Value

			'Entity Name

			.Worksheets("Data Dictionary").Cells(curRow, 2).Value = .Worksheets("Dump").Cells(j, 5).Value

			'Field Name

			.Worksheets("Data Dictionary").Cells(curRow, 3).Value = .Worksheets("Dump").Cells(j, 6).Value

			'Attribute Name

			.Worksheets("Data Dictionary").Cells(curRow, 4).Value = .Worksheets("Dump").Cells(j, 7).Value

			'Defintion

			.Worksheets("Data Dictionary").Cells(curRow, 5).Value = .Worksheets("Dump").Cells(j, 8).Value

			'Data Type

			.Worksheets("Data Dictionary").Cells(curRow, 6).Value = .Worksheets("Dump").Cells(j, 9).Value

			'Data Length

			.Worksheets("Data Dictionary").Cells(curRow, 7).Value = .Worksheets("Dump").Cells(j, 10).Value

			.Worksheets("Data Dictionary").Cells(curRow, 7).HorizontalAlignment = xlLeft

			'Data Format

			.Worksheets("Data Dictionary").Cells(curRow, 8).Value = .Worksheets("Dump").Cells(j, 11).Value

			.Worksheets("Data Dictionary").Cells(curRow, 8).HorizontalAlignment = xlLeft

			'Field Status

			.Worksheets("Data Dictionary").Cells(curRow, 9).Value = .Worksheets("Dump").Cells(j, 12).Value

			'Data Rules and Dependencies

			.Worksheets("Data Dictionary").Cells(curRow, 10).Value = .Worksheets("Dump").Cells(j, 13).Value

			'Remarks

			.Worksheets("Data Dictionary").Cells(curRow, 11).Value = .Worksheets("Dump").Cells(j, 14).Value

			prevScreenName = curScreenName

			curRow = curRow + 1

		Next

	End With    

End Sub

'*******************************************************************************************

'print a cell in the excel worksheet

Sub PrintCell(value, row, col, rowInc, colInc)

	excelApp.ActiveSheet.Cells(row, col).Value = value

	curRow = curRow + rowInc

	curCol = curCol + colInc

End Sub

'*******************************************************************************************

'delete the meta and dump worksheets

Sub DeleteSheets

	excelApp.DisplayAlerts = False

    excelApp.Worksheets("Dump").Delete

    excelApp.DisplayAlerts = True

End Sub

'*******************************************************************************************

Sub PrintScreenName(screenName, rowNum, subTypeCount)

	With excelApp

		if (subTypeCount = 0) then

			.Worksheets("Data Dictionary").Range(.Cells(rowNum, 1), .Cells(rowNum, 11)).Select

		else

			.Worksheets("Data Dictionary").Range(.Cells(rowNum, 1), .Cells(rowNum, subTypeCount + 8)).Select

		end if

		With .Selection

			.HorizontalAlignment = xlLeft

			.MergeCells = False

			.Font.Bold =True

			With .Interior

				.ColorIndex = 15

				.Pattern = xlSolid

			End With

		End With

		.Worksheets("Data Dictionary").Cells(rowNum, 1).Value = screenName

	End With    

End Sub

'*******************************************************************************************

Open in new window

0
Comment
Question by:froggy_bill
  • 2
5 Comments
 
LVL 54

Accepted Solution

by:
b0lsc0tt earned 500 total points
ID: 20405467
Do you get a line number or any other info with the error?  If so please let us know which line above the error relates to.

One suggestion to hopefully get better info for this problem is to remove (or comment out) the On Error Resume Next line.

Let me know if you have a question.

bol
0
 
LVL 12

Expert Comment

by:chandru_sol
ID: 20408461
Are you using this in excel macros?
0
 

Author Comment

by:froggy_bill
ID: 20414424
I fixed it....thanks.
0
 
LVL 54

Expert Comment

by:b0lsc0tt
ID: 20415187
Did any of the comments above help with the fix?  If so then you can close this by accepting one (or more) of them.  If they didn't help then you could post the solution so this question can be kept.  Your points will be refunded.  If you can't post the solution but it is solved with no help from the comments above then let us know.  This question can then be deleted.  To use the last few options you would usually need to ask a moderator to help by posting in the General Community Support zone.  I can help you close this if you want though.

b0lsc0tt
EE Zone Advisor
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Does the idea of dealing with bits scare or confuse you? Does it seem like a waste of time in an age where we all have terabytes of storage? If so, you're missing out on one of the core tools in every professional programmer's toolbox. Learn how to …
Computer science students often experience many of the same frustrations when going through their engineering courses. This article presents seven tips I found useful when completing a bachelors and masters degree in computing which I believe may he…
Viewers will learn how to properly install Eclipse with the necessary JDK, and will take a look at an introductory Java program. Download Eclipse installation zip file: Extract files from zip file: Download and install JDK 8: Open Eclipse and …
In this fourth video of the Xpdf series, we discuss and demonstrate the PDFinfo utility, which retrieves the contents of a PDF's Info Dictionary, as well as some other information, including the page count. We show how to isolate the page count in a…

914 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

21 Experts available now in Live!

Get 1:1 Help Now