Update 12/30/2023
I was mistaken, excelApp.Visible = True or False and excelApp.Quit() make no difference the excel app continues to show in task manger. When pushing Parameters from an assembly or simply creating a new Part I end up with an instance showing in task manager for every part.
Hi A.Acheson,
I was able to kill the process by changing excel.app.visible to true. I'm still uncertain if the rule is actually checking to see if the part number exists. My thoughts are that I would trigger the rule on creation of a new part and create some variation of the Code to run on sheet metal parts only when pushing Parameters from an Assembly.
See Code Below (borrowed and modified from a snippet by Curtis Waguespack)
Sub Main()
Dim oDoc As Document = ThisDoc.Document
iLogicVb.UpdateWhenDone = True
Top:
oFile = "Path\File.xlsx"
'define Excel Application object
excelApp = CreateObject("Excel.Application")
'set Excel to run invisibly, change to true if you want to run it visibly
excelApp.Visible = True
'suppress prompts (such as the compatibility checker)
excelApp.DisplayAlerts = False
Dim xCharArray() As Char = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ".ToCharArray
Dim xNoArray() As Char = "0123456789".ToCharArray
Dim xGenerator As System.Random = New System.Random()
Dim xStr As String = String.Empty
While xStr.Length < 10
If xGenerator.Next(0, 2) = 0 Then
xStr &= xCharArray(xGenerator.Next(0, xCharArray.Length))
Else
xStr &= xNoArray(xGenerator.Next(0, xNoArray.Length))
End If
End While
oValueToMatch = xStr
Dim oProName1 As String = "Default Table Part Number"
Dim oProName2 As String = "Default Table Description"
Dim oProSet As Inventor.PropertySet = ThisApplication.ActiveDocument.PropertySets.Item("User Defined Properties")
Dim oProp As Inventor.Property
Try
oProp = oProSet(oProName1)
oProp = oProSet(oProName2)
Catch
oProp = oProSet.Add("",oProName1)
oProp = oProSet.Add("",oProName2)
End Try
If iProperties.Value("Custom","Default Table Part Number")= "" Then
GoTo DescNeeded
Else If iProperties.Value("Custom","Default Table Part Number") > "" Then
GoTo UserTime
End If
DescNeeded :
Desc = InputBox("Excel Table Description, ie: FT90FM, End Cap", "Enter Description Here")
iProperties.Value("Custom", "Default Table Part Number") = xStr
iProperties.Value("Custom", "Default Table Description") = Desc
oTime = Now.ToShortDateString
oUser = iProperties.Value("Custom", "ModifiedBy")
oDescriptionToMatch = Desc
iProperties.Value("Project","Part Number") = xStr
Goto StartPNAdd
UserTime :
iProperties.Value("Project","Part Number") = xStr
oTime = Now.ToShortDateString
oUser = iProperties.Value("Custom", "ModifiedBy")
oDescriptionToMatch = iProperties.Value("Custom", "Default Table Description")
StartPNAdd:
If Dir(oFile) <> "" Then
'workbook exists, open it
oWB = excelApp.Workbooks.Open(oFile)
oWS = oWB.Worksheets(1)
Else
Return 'exit rule
End If
'Loop through the rows In column A
For iRow = 2 To oWS.UsedRange.Rows.Count
'get value of the cell
oCellValue = oWS.Cells(iRow, "A" ).Value
If oCellValue = oValueToMatch Then
oWS.Cells(iRow, "A").Value = oCellValue + 1
oFound = True
Goto Top
Else
oFound = False
End If
Next iRow
If oFound = False Then
oWS.Cells(oWS.UsedRange.Rows.Count + 1, "A").Value = oValueToMatch
oWS.Cells(oWS.UsedRange.Rows.Count, "B").Value = oDescriptionToMatch
oWS.Cells(oWS.UsedRange.Rows.Count, "C").Value = oTime
oWS.Cells(oWS.UsedRange.Rows.Count, "D").Value = oUser
End If
'set all of the columns to autofit
excelApp.Columns.AutoFit
'save the file
oWB.Save
oDoc.Save
'close the workbook and the Excel Application
oWB.Close
excelApp.Quit()
'excelApp = Nothing
End Sub
Thanks,
Brent