AddReference "Microsoft.Office.Interop.Excel.dll" Imports Microsoft.Office.Interop.Excel Imports System.Windows.Forms Sub Main 'Specify the Excel file's (Workbook) full path & file name (with extension) 'It is calling a Windows OpenFileDialog to allow the user to do this Dim sFileName As String = GetExcelFile() If sFileName = "" Then Exit Sub '< ADDED THIS CHECK > 'Specify the Sheet name within the workbook 'perhaps this name could be selected from a list of all available sheets 'in the Excel Workbook once opened, of you don't want to manually specify it here? Dim sSheetName As String = "Sheet1" 'Start a new instance of the Excel application Dim oExcelApp As Microsoft.Office.Interop.Excel.Application oExcelApp = New Microsoft.Office.Interop.Excel.ApplicationClass oExcelApp.DisplayAlerts = False oExcelApp.Visible = False '[ Attempt to open the specified Workbook (file) using the supplied file name Dim oWB As Workbook Try oWB = oExcelApp.Workbooks.Open(sFileName) Catch oEx As Exception MsgBox("The attempt to open the Excel file named '" & sFileName & "' failed." & vbCrLf & _ "The error message for this failure is as follows:" & vbCrLf & _ oEx.Message & vbCrLf & vbCrLf & _ "Its 'StackTrace is as follows:" & vbCrLf & _ oEx.StackTrace & vbCrLf & vbCrLf & _ "Its source is as follows:" & vbCrLf & _ oEx.Source, vbCritical, "Couldn't Open File") Exit Sub End Try 'Attempt to get the Worksheet Dim oWS As Worksheet Try oWS = oWB.Sheets.Item(sSheetName) Catch oWS = oWB.ActiveSheet Catch oWS = oWB.Worksheets.Item(1) Catch MsgBox("No Worksheet was found in the specified Excel file. Exiting.", vbCritical, " ") Exit Sub End Try Dim oCells As Range = oWS.Cells 'Define the active Assembly and all related variables If ThisDoc.Document.DocumentType <> DocumentTypeEnum.kAssemblyDocumentObject Then MsgBox("This rule '" & iLogicVb.RuleName & "' only works for Assembly Documents.", vbCritical, "WRONG DOCUMENT TYPE") Exit Sub End If Dim oADoc As AssemblyDocument = ThisDoc.Document Dim sDir As String = System.IO.Path.GetDirectoryName(oADoc.FullFileName) Dim oADef As AssemblyComponentDefinition = oADoc.ComponentDefinition Dim oOccs As ComponentOccurrences = oADef.Occurrences Dim oOcc As ComponentOccurrence Dim oDProps As Inventor.PropertySet 'Design Tracking Properties (Project) Dim oSProps As Inventor.PropertySet 'Inventor Summary Information (Summary) Dim oCProps As Inventor.PropertySet 'Inventor User Defined Properties (Csutom) Dim oMatrix As Inventor.Matrix = ThisApplication.TransientGeometry.CreateMatrix 'Find the last row and last column being used to limit our loop ranges Dim oLastRow As Integer = oWS.UsedRange.Rows.Count 'Dim oLastCol As Integer = oWS.UsedRange.Columns.Count 'Dim oColumnHeadersRow As Integer = 1 Dim o1stDataRow As Integer = 2 Dim oRow, oQty As Integer Dim sPName, sPNum, sVendor, sNotes, sSAP As String For oRow = o1stDataRow To oLastRow 'First number is Row index, second number is Column Index oQty = Convert.ToString(oCells.Item(oRow, 1).Value) sPName = Convert.ToString(oCells.Item(oRow, 2).Value) sPNum = Convert.ToString(oCells.Item(oRow, 3).Value) sVendor = Convert.ToString(oCells.Item(oRow, 4).Value) sNotes = Convert.ToString(oCells.Item(oRow, 5).Value) sSAP = Convert.ToString(oCells.Item(oRow, 6).Value) 'Create the new Part Dim oPDoc As PartDocument = ThisApplication.Documents.Add(DocumentTypeEnum.kPartDocumentObject, , False) 'Set the iProperties within the new Part oDProps = oPDoc.PropertySets.Item("Design Tracking Properties") oSProps = oPDoc.PropertySets.Item("Inventor Summary Information") oCProps = oPDoc.PropertySets.Item("Inventor User Defined Properties") oDProps.Item("Description").Value = sPName oDProps.Item("Part Number").Value = sPNum oDProps.Item("Vendor").Value = sVendor oSProps.Item("Comments").Value = sNotes Try oCProp = oCProps.Item("CDB Artikelnummer") oCProp.Value = sSAP Catch oCProp = oCProps.Add(sSAP, "CDB Artikelnummer") End Try '<<<< !!! CHECK IF THIS IS OK BEFORE RUNNING !!! >>>> 'Saving each new Part to the same directory as the Assembly 'if this is not OK, you could specify a different directory 'or you could use a SaveFileDialog for this 'or just skip saving the parts at this stage altogether Dim sFFN As String = sDir & "\" & sPName & ".ipt" If IsValidFullFileName(sFFN) = False Then MessageBox.Show("The path &/or file name specified is not valid.", _ "File Path/Name Invalid", MessageBoxButtons.OK, MessageBoxIcon.Warning) Continue For End If If System.IO.File.Exists(sFFN) Then Dim oAns As DialogResult = MessageBox.Show("A Part file with the following full file name already exists:" _ & vbCrLf & sFFN & vbCrLf & "Do you want to overwrite it?", "Part File Already Exists", _ MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button2) If oAns = DialogResult.No Then Continue For End If Try oPDoc.SaveAs(sFFN, False) Catch oEx As Exception MessageBox.Show("Error using SaveAs method with the following FullFileName:" & vbCrLf & sFFN, _ "SaveAs Error", MessageBoxButtons.OK, MessageBoxIcon.Error) 'Continue For End Try 'Add that many of this part to the assembly For i = 1 To oQty Try oNewOcc = oOccs.AddByComponentDefinition(oPDoc.ComponentDefinition, oMatrix) Catch oEx As Exception MessageBox.Show("Error using AddByComponentDefinition method.", "AddByComponentDefinition Error", MessageBoxButtons.OK, MessageBoxIcon.Error) End Try Next 'i Next 'oRow 'Close the Workbook (file) oWB.Close 'Close this instance of the Excel application oExcelApp.Quit End Sub Function GetExcelFile() As String Dim oOpenDlg As New System.Windows.Forms.OpenFileDialog oOpenDlg.Title = "Browse To And Select Your Excel File." oOpenDlg.InitialDirectory = ThisApplication.DesignProjectManager.ActiveDesignProject.WorkspacePath oOpenDlg.Filter = "Excel Files (*.xls;*.xlsx)|*.xls;*.xlsx" oOpenDlg.Multiselect = False oOpenDlg.RestoreDirectory = False Dim oResult As System.Windows.Forms.DialogResult = oOpenDlg.ShowDialog Return oOpenDlg.FileName End Function Function IsValidFullFileName(ByVal sFullFileName As String) As Boolean Dim sPath As String = System.IO.Path.GetDirectoryName(sFullFileName) Dim sFileName As String = System.IO.Path.GetFileName(sFullFileName) If sPath.Intersect(System.IO.Path.GetInvalidPathChars()).Any() Then Return False If sFileName.Intersect(System.IO.Path.GetInvalidFileNameChars()).Any() Then Return False Return True End Function