Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
HideoYamada
in reply to: EMVC

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 Sub

See the video also :

https://autode.sk/2mzItnR

 

Is this code helping you?

 

=====

Freeradical

 Hideo Yamada

 

=====
Freeradical
 Hideo Yamada
https://www.freeradical.jp