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?
