Announcements
Attention for Customers without Multi-Factor Authentication or Single Sign-On - OTP Verification rolls out April 2025. Read all about it here.
rhjones74
542 Views, 1 Reply

Mass Changing Default BOM Structure for multiple parts using VBA Code

I am trying to change the default BOM Structure from Normal to Purchased for over 19,000 parts and assemblies using a string of VBA code to avoiding manually changing the setting for each individual part. I tested my code out in Excel and it worked perfectly, however it does not work in Inventor and I've hit a roadblock trying to troubleshoot it. When ran in Excel, it takes your designated file path and changes values in the specified cell in all excel values inside that folder and subsequent subfolders, just like I would like it to run in Inventor. I'm not sure why it does not work, I assume it has something to do with changing from the Excel program and going to a non-Microsoft program in Inventor.

 

I have very little experience in programming and even less in VBA, so any help is appreciated. Thanks!

 

Here is my Excel code that runs just fine:

 

 

Public Sub openWB()
Dim FSO As Object
Dim folder As Object, subfolder As Object
Dim wb As Object

Set FSO = CreateObject("Scripting.FileSystemObject")
folderPath = "INSERT FILE PATH HERE"
Set folder = FSO.GetFolder(folderPath)

With Application
.DisplayAlerts = False
.ScreenUpdating = False
.EnableEvents = False
.AskToUpdateLinks = False
End With

For Each wb In folder.Files
If Right(wb.Name, 3) = "xls" Or Right(wb.Name, 4) = "xlsx" Or Right(wb.Name, 4) = "xlsm" Then
Set masterWB = Workbooks.Open(wb)
Cells(1, 1).Value = 4000
ActiveWorkbook.Close True
End If
Next
For Each subfolder In folder.SubFolders
For Each wb In subfolder.Files
If Right(wb.Name, 3) = "xls" Or Right(wb.Name, 4) = "xlsx" Or Right(wb.Name, 4) = "xlsm" Then
Set masterWB = Workbooks.Open(wb)
Cells(1, 1).Value = 4000
ActiveWorkbook.Close True
End If
Next
Next
With Application
.DisplayAlerts = True
.ScreenUpdating = True
.EnableEvents = True
.AskToUpdateLinks = True
End With
End Sub

 

 

Here is my Inventor code that either gives a run-time error or runs but does not actually change the default BOM structure (bolded are the main changes from the Excel code):

 

 

Public Sub openWB()
    Dim FSO As Object
    Dim folder As Object, subfolder As Object
    Dim wb As Object
    
    Set FSO = CreateObject("Scripting.FileSystemObject")
    folderPath = "INSERT FILE PATH HERE"
    Set folder = FSO.GetFolder(folderPath)
    
    'With Application
        '.DisplayAlerts = False
        '.ScreenUpdating = False
        '.EnableEvents = False
        '.AskToUpdateLinks = False
    'End With
        
    For Each wb In folder.Files
        If Right(wb.Name, 3) = "ipt" Or Right(wb.Name, 3) = "iam" Then
            Set masterWB = Workbooks.Open(wb)
                Dim oDoc As PartDocument
Set oDoc = ThisApplication.ActiveDocument
oDoc.ComponentDefinition.BOMStructure = kPurchasedBOMStructure ActiveWorkbook.Close True End If Next For Each subfolder In folder.SubFolders For Each wb In subfolder.Files If Right(wb.Name, 3) = "ipt" Or Right(wb.Name, 3) = "iam" Then Set masterWB = Workbooks.Open(wb) Dim oDoc As PartDocument
Set oDoc = ThisApplication.ActiveDocument
oDoc.ComponentDefinition.BOMStructure = kPurchasedBOMStructure ActiveWorkbook.Close True End If Next Next 'With Application '.DisplayAlerts = True '.ScreenUpdating = True '.EnableEvents = True '.AskToUpdateLinks = True 'End With End Sub