Solved

Microsoft VBScript runtime error 424

Posted on 2007-12-04
5
8,238 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
Comment Utility
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
Comment Utility
Are you using this in excel macros?
0
 

Author Comment

by:froggy_bill
Comment Utility
I fixed it....thanks.
0
 
LVL 54

Expert Comment

by:b0lsc0tt
Comment Utility
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

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

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 …
Although it can be difficult to imagine, someday your child will have a career of his or her own. He or she will likely start a family, buy a home and start having their own children. So, while being a kid is still extremely important, it’s also …
An introduction to basic programming syntax in Java by creating a simple program. Viewers can follow the tutorial as they create their first class in Java. Definitions and explanations about each element are given to help prepare viewers for future …
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…

743 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

14 Experts available now in Live!

Get 1:1 Help Now