' False Sub Main() Dim oDoc As Document = ThisDoc.Document Top: Warning = MessageBox.Show("Save & Close Any Open Excel Documents Before Proceeding" & vBlf & "OK = Proceed" & vBlf & "Cancel = Exit", "iLogic Caustion", MessageBoxButtons.OKCancel, MessageBoxIcon.Warning) If Warning = vbCancel Then Exit Sub Else End If 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 Dim iLogicQuestion1 = MessageBox.Show("Will This Part Number Be Fixed? If Yes Then Select Yes","Fixed Part Number", MessageBoxButtons.YesNoCancel,MessageBoxIcon.Question) If iLogicQuestion1 = vbYes Then iProperties.Value("Custom", "Fixed Part Number") = "Yes" Else If iLogicQuestion1 = vbNo Then iProperties.Value("Custom", "Fixed Part Number") = "No" Else If iLogicQuestion1 = vbCancel Then Exit Sub End If Desc = InputBox("Excel Table Description, ie: FT90FM, End Cap", "Enter Description Here") 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 iProperties.Value("Custom", "Default Table Part Number") = xStr iProperties.Value("Custom", "Default Table Description") = Desc Dim Time As DateTime = DateTime.Now Dim Format As String = "M/d/yyyy" & " HH:mm" oDateTime = Time.ToString(Format) oUser = ThisApplication.GeneralOptions.UserName oDescriptionToMatch = Desc iProperties.Value("Project","Part Number") = xStr iLogicVb.UpdateWhenDone = True 'define Excel Application object excelApp = CreateObject("Excel.Application") 'define Excel file to open oFile = "C:\Users\Public\Documents\Autodesk\ARSCO Standards\iLogic\Random Part Number Generator.xlsx" 'set Excel to run invisibly, change to true if you want to run it visibly excelApp.Visible = False 'suppress prompts (such as the compatibility checker) excelApp.DisplayAlerts = False If Dir(oFile) <> "" Then 'workbook exists, open it oWB = excelApp.Workbooks.Open(oFile) oWS = oWB.Worksheets(1) Else MessageBox.Show("File Not Found" & vbLf & "• Ckeck the Path And File Name For Errors" & vBlf & "• Check To See If The File Was Moved, Renamed Or Deleted", "iLogic Error", MessageBoxButtons.OK,MessageBoxIcon.Exclamation) Exit Sub 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 = xStr Then GoTo Top Else oFound = False End If Next iRow If oFound = False Then oWS.Cells(oWS.UsedRange.Rows.Count + 1, "A").Value = xStr oWS.Cells(oWS.UsedRange.Rows.Count, "B").Value = oDescriptionToMatch oWS.Cells(oWS.UsedRange.Rows.Count, "C").Value = oDateTime 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 'close the workbook and the Excel Application oWB.Close 'quit excelApp caution this will close any open Excel File Dim oServ As Object Dim oProc As Object oServ = GetObject("winmgmts:") cProc = oServ.ExecQuery("Select * from Win32_Process") For Each oProc In cProc 'NOTE: It is 'case sen'sitive If oProc.Name = "EXCEL.EXE" Then oProc.Terminate() End If Next End Sub