- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello
is there a vba thats can export several parts list to one excel book
Lets say may poject in one order is based on 10 idw files , can that easealy be exported to one excel book not sheet
one partlist one one tab
Solved! Go to Solution.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello,
I made sample code that collect the BOMs of the drawing documents which are opened.
Option Explicit
Private Const TempWorkBookName = "TempWorkBook.xlsx"
Private oExcelApp As Excel.Application
Private TempWorkbookFullName As String
Public Sub CollectOpenedIdwBOMs()
' Init WSH and temp path
Dim WSH As Variant
Set WSH = CreateObject("WScript.Shell")
TempWorkbookFullName = WSH.SpecialFolders("Desktop") & "\" & TempWorkBookName
' Setup Excel
Set oExcelApp = CreateObject("Excel.Application")
oExcelApp.Visible = True
oExcelApp.DisplayAlerts = False
Dim oWorkbook As Workbook
Set oWorkbook = oExcelApp.Workbooks.Add
' Create AssyDoc collection
Dim oAssyDocs As ObjectCollection
Set oAssyDocs = CreateAssyDocs
' Collect BOMs into one workbook
MsgBox "Start Step 1"
CollectBOMsFromDocs oAssyDocs, oWorkbook
' Combine worksheets into one sheet
MsgBox "Start Step 2"
CombineWorksheets oWorkbook
' end
oExcelApp.DisplayAlerts = True
Set oExcelApp = Nothing
MsgBox "End"
End Sub
Private Function CreateAssyDocs() As ObjectCollection
Set CreateAssyDocs = ThisApplication.TransientObjects.CreateObjectCollection
Dim oDoc As Document
For Each oDoc In ThisApplication.Documents
If TypeOf oDoc Is DrawingDocument Then
Dim oDrawingDoc As DrawingDocument
Set oDrawingDoc = oDoc
Dim oRefedDoc As Document
Set oRefedDoc = oDrawingDoc.ActiveSheet.DrawingViews(1).ReferencedDocumentDescriptor.ReferencedDocument
If TypeOf oRefedDoc Is AssemblyDocument And oRefedDoc.ComponentDefinition.BOM.StructuredViewEnabled Then
CreateAssyDocs.Add oRefedDoc
End If
End If
Next oDoc
End Function
Private Sub CollectBOMsFromDocs(oAssyDocs As ObjectCollection, oWorkbook As Workbook)
Dim oAssyDoc As AssemblyDocument
For Each oAssyDoc In oAssyDocs
ExportBOMAsWorkbook oAssyDoc
Dim oTempWorkbook As Workbook
Set oTempWorkbook = oExcelApp.Workbooks.Open(TempWorkbookFullName)
oTempWorkbook.Sheets(1).Move After:=oWorkbook.Sheets(1)
Kill TempWorkbookFullName
Next oAssyDoc
End Sub
Private Sub CombineWorksheets(oWorkbook As Workbook)
If oWorkbook.Sheets.Count <= 1 Then
Exit Sub
End If
' Copy title line
oWorkbook.Sheets(2).Rows(1).Copy oWorkbook.Sheets(1).Rows(1)
' Copy all sheets into one
Dim oSheet As WorkSheet
Dim rowIndex As Integer
rowIndex = 2
While oWorkbook.Sheets.Count > 1
Dim r As Range
' Set r = oWorkbook.Sheets(2).Cells(2, 1)
' Set r = Range(r, r.End(xlDown)).EntireRow
Set r = oWorkbook.Sheets(2).Rows("2:" & oWorkbook.Sheets(2).Cells(2, 1).End(xlDown).Row)
r.Copy oWorkbook.Sheets(1).Cells(rowIndex, 1)
rowIndex = rowIndex + r.Rows.Count
oWorkbook.Sheets(2).Delete
Wend
End Sub
Private Sub ExportBOMAsWorkbook(oAssyDoc As AssemblyDocument)
Call oAssyDoc.ComponentDefinition.BOM.BOMViews("Structured").Export(TempWorkbookFullName, kMicrosoftExcelFormat, oAssyDoc.DisplayName)
End SubSee the video also :
Is this code helping you?
=====
Freeradical
Hideo Yamada
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi EMVC,
These four lines must be deleted.
(They don't exist in original code which I posted.)
=====
Freeradical
Hideo Yamada
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
I can not understand what i do wrong, i have placed the code under Module 1
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello,
You must add Reference to Excel Object Library in Inventor.
VBA Editor -> Tools -> References -> :
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hello
Thank you now i getting somwhere, but i get data from Bill of materials not Partlist, se pictures
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Hi EMVC,
If you need Part List on the drawing document, delete all the codes and insert follows :
Option Explicit
Private Const TempWorkBookName = "TempWorkBook.xlsx"
Private oExcelApp As Excel.Application
Private TempWorkbookFullName As String
Public Sub CollectOpenedIdwPartLists()
' Init WSH and temp path
Dim WSH As Variant
Set WSH = CreateObject("WScript.Shell")
TempWorkbookFullName = WSH.SpecialFolders("Desktop") & "\" & TempWorkBookName
' Setup Excel
Set oExcelApp = CreateObject("Excel.Application")
oExcelApp.Visible = True
oExcelApp.DisplayAlerts = False
Dim oWorkbook As Workbook
Set oWorkbook = oExcelApp.Workbooks.Add
' Create DrawingDoc collection
Dim oDrawingDocs As ObjectCollection
Set oDrawingDocs = CreateDrawingDocs
' Collect BOMs into one workbook
MsgBox "Start Step 1"
CollectPartListsFromDocs oDrawingDocs, oWorkbook
' Combine worksheets into one sheet
MsgBox "Start Step 2"
CombineWorksheets oWorkbook
' end
oExcelApp.DisplayAlerts = True
Set oExcelApp = Nothing
MsgBox "End"
End Sub
Private Function CreateDrawingDocs() As ObjectCollection
Set CreateDrawingDocs = ThisApplication.TransientObjects.CreateObjectCollection
Dim oDoc As Document
For Each oDoc In ThisApplication.Documents
If TypeOf oDoc Is DrawingDocument Then
Dim oDrawingDoc As DrawingDocument
Set oDrawingDoc = oDoc
If oDrawingDoc.ActiveSheet.PartsLists.Count > 0 Then
CreateDrawingDocs.Add oDrawingDoc
End If
End If
Next oDoc
End Function
Private Sub CollectPartListsFromDocs(oDrawingDocs As ObjectCollection, oWorkbook As Workbook)
Dim oDrawingDoc As DrawingDocument
For Each oDrawingDoc In oDrawingDocs
ExportPartListAsWorkbook oDrawingDoc
Dim oTempWorkbook As Workbook
Set oTempWorkbook = oExcelApp.Workbooks.Open(TempWorkbookFullName)
oTempWorkbook.Sheets(1).Move After:=oWorkbook.Sheets(1)
Kill TempWorkbookFullName
Next oDrawingDoc
End Sub
Private Sub CombineWorksheets(oWorkbook As Workbook)
If oWorkbook.Sheets.Count <= 1 Then
Exit Sub
End If
' Copy title line
oWorkbook.Sheets(2).Rows(1).Copy oWorkbook.Sheets(1).Rows(1)
' Copy all sheets into one
Dim oSheet As WorkSheet
Dim rowIndex As Integer
rowIndex = 2
While oWorkbook.Sheets.Count > 1
Dim r As Range
' Set r = oWorkbook.Sheets(2).Cells(2, 1)
' Set r = Range(r, r.End(xlDown)).EntireRow
Set r = oWorkbook.Sheets(2).Rows("2:" & oWorkbook.Sheets(2).Cells(2, 1).End(xlDown).Row)
r.Copy oWorkbook.Sheets(1).Cells(rowIndex, 1)
rowIndex = rowIndex + r.Rows.Count
oWorkbook.Sheets(2).Delete
Wend
End Sub
Private Sub ExportPartListAsWorkbook(oDrawingDoc As DrawingDocument)
oDrawingDoc.ActiveSheet.PartsLists(1).Export TempWorkbookFullName, kMicrosoftExcel, oDrawingDoc.DisplayName
End Sub
And if you don't need to combine lists into one sheet, comment out following codes or simply delete them :
' Combine worksheets into one sheet
MsgBox "Start Step 2"
CombineWorksheets oWorkbook
=====
Freeradical
Hideo Yamada
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Need help with this one.
I tried to use this example code and get a blank excel document and errors.
Please see attached
Thanks
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report
Disregard my last post.
The macro starts a blank excel workbook step1, step2 and end message works but nothing populates in excel work book.
Any idea's would be helpful
Thanks