asked on
Microsoft VBScript runtime error 424

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
ASKER CERTIFIED SOLUTION
b0lsc0tt
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
chandru_sol
Are you using this in excel macros?
froggy_bill
ASKER
I fixed it....thanks.
b0lsc0tt
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