Community
Hello,
When i run this code I get a error at msgbox ("6")
It runs the code but I get the error
Export failed, contact cad admin
Try excelApp = CreateObject("Excel.Application") excelApp.Visible = False excelApp.DisplayAlerts = False MsgBox("1") If IO.File.Exists(oExportName) Then IO.File.Delete(oExportName) If Dir(oExportName) <> "" Then Kill (oExportName) End If MsgBox("2") Dim strTemplate As String = ThisApplication.DesignProjectManager.ActiveDesignProject.DesignDataPath & "\XLS\en-US\DrawingList Template.xlsx" System.IO.File.Copy(strTemplate, oExportName, True) MsgBox("3") 'set readonly to false Dim fInfo As New FileInfo(oExportName) fInfo.IsReadOnly = False MsgBox("4") wb1 = excelApp.Workbooks.Open(oExportName) ws1 = wb1.Worksheets(1) MsgBox("5") 'Start Traverse MainDoc() Dim oAsmDoc As AssemblyDocument = ThisDoc.Document MsgBox("6") TraverseAssembly(oAsmDoc.ComponentDefinition.Occurrences, 1) MsgBox("7") Dim Rowcounter As Integer = startrow Dim strFilename As String = "" Dim oProp As Inventor.Property MsgBox("8") 'DrawingList Properties 'Client ws1.Cells(2, 6).value = strClient MsgBox("9") 'Project Number ws1.Cells(3, 6).value = GetiPropertyValue(oAsmDoc, "Inventor User Defined Properties", "Drawing Number") MsgBox("10") 'Author ws1.Cells(4, 6).value = ThisApplication.GeneralOptions.UserName MsgBox("11") 'Creation Date Dim CreationDate As DateTime = DateTime.Now Dim CreationDateFormat As String = "dd/MM/yyyy" Dim intMinute As String = Now.Minute If Now.Minute < 10 Then intMinute = "0" & intMinute CreationTime = (Now.Hour) & ":" & intMinute ws1.Cells(5, 6).value = CreationDate.ToString(CreationDateFormat + " - " + CreationTime) MsgBox("12") 'Row Properties Dim Drawdoc As DrawingDocument Dim Modeldoc As Document Dim HasDrawing As Boolean Dim DocType As DocumentTypeEnum MsgBox("13") Dim oProgressbar As Inventor.ProgressBar oProgressStep = 1 oProgressSteps = ModelList.Count - 1 oProgressStaticText = "Creating excel, please wait" oProgressbar = ThisApplication.CreateProgressBar(False, oProgressSteps, "Creating EXCEL") MsgBox("14") For i = 0 To ModelList.Count - 1 'Document If DrawList.Item(i) = "" Then : HasDrawing = False: Else : HasDrawing = True: End If If HasDrawing = True Then Drawdoc = ThisApplication.Documents.Open(DrawList.Item(i), False) Modeldoc = ThisApplication.Documents.Open(ModelList.Item(i), False) DocType = Modeldoc.DocumentType MsgBox("15") If Not (DocType = DocumentTypeEnum.kPartDocumentObject And HasDrawing = False) Then 'Article Number ws1.Cells(Rowcounter, 2).value = GetiPropertyValue(Modeldoc, "Inventor User Defined Properties", "article_number") MsgBox("16") 'Drawing Number ws1.Cells(Rowcounter, 3).value = GetiPropertyValue(Modeldoc, "Inventor User Defined Properties", "Drawing Number") MsgBox("17") 'Rev If HasDrawing = True Then ws1.Cells(Rowcounter, 4).value = GetiPropertyValue(Drawdoc, "Inventor Summary Information", "Revision Number") MsgBox("18") 'Description ws1.Cells(Rowcounter, 5).value = GetiPropertyValue(Modeldoc, "Design Tracking Properties", "Description") MsgBox("19") 'IDW If HasDrawing = True Then ws1.Cells(Rowcounter, 6).value = "" If HasDrawing = False Then ws1.Cells(Rowcounter, 6).value = "X" MsgBox("20") 'Document Type If DocType = DocumentTypeEnum.kAssemblyDocumentObject Then ws1.Cells(Rowcounter, 7).value = "Assembly" If DocType = DocumentTypeEnum.kPartDocumentObject Then ws1.Cells(Rowcounter, 7).value = "Part" MsgBox("21") 'Regel opschonen en afsluiten voor volgende regel Rowcounter = Rowcounter + 1 If Not Modeldoc Is oAsmDoc Then Modeldoc.Close(True) If HasDrawing = True Then Drawdoc.Close(True) Modeldoc = Nothing Drawdoc = Nothing End If oProgressStep += 1 oProgressbar.UpdateProgress Next MsgBox("22") 'excel schoonmaken wb1.Save wb1.Close 'Open Drawlist excelApp.Visible = True excelApp.Workbooks.Open(oExportName) excelApp = Nothing Catch MsgBox("Export failed, contact cad admin") If not wb1 is nothing then wb1.Close System.Runtime.InteropServices.Marshal.ReleaseComObject(excelApp) End Try End Sub Function GetiPropertyValue(doc As Inventor.Document, Propset As String, iProp As String) As String Try Dim oPropSet As Inventor.PropertySet = doc.PropertySets.Item(Propset) Dim oProp As Inventor.Property = oPropSet.Item(iProp) GetiPropertyValue = oProp.Value Catch 'MsgBox("Failed to GET iprop:" & vbLf & Propset & vbLf & iProp) GetiPropertyValue = "iprop not found" End Try End Function
And I cant figure out how I can fix this, can someone help me?
The document your working with where is that object coming from? What documents are you looking to process and where are you launching the rule?
TraverseAssembly sub routine is missing. The call is here but the code isn't shown. MainDoc is not declared as an object in the code.
Start Traverse MainDoc() Dim oAsmDoc As AssemblyDocument = ThisDoc.Document MsgBox("6") TraverseAssembly(oAsmDoc.ComponentDefinition.Occurrences, 1)
Can't find what you're looking for? Ask the community or share your knowledge.