Run macro on directory of drawings

[Anonymous]

I am trying to run a macro (ExportPartslisttoExcel) on a directory of drawings.  I have started with Mod the Machine's code to print a directory of drawings to PDF.  When I copy the code to the Microsoft Visual Basic for Applications editor in Inventor I get a syntax error on the lines highlited in red.  Can anyone tell me how correct this?

Thanks in advance.

Public Sub ToExcel()

    ' Get the drawing directory to be processed
    Dim txtPath As String
    txtPath = "\\SOTAWIN2\Drafting\Projects\14-07 Seaport B\Inventor\F - Frames\"
    
    ' Get all of the drawing files in the directory and subdirectories.
    Dim drawings() As String = System.IO.Directory.GetFiles(txtPath, "*.idw", System.IO.SearchOption.AllDirectories)

    ' Iterate through the found drawings.
    For Each drawing As String In drawings
        Dim drawDoc As Inventor.DrawingDocument
        drawDoc = invApp.Documents.Open(Drawing)

        ' Export parts list info to Excel
        ExportPartslisttoExcel

        ' Close the drawing.
        drawDoc.Close (True)
    Next

End Sub

[MechMachineMan]

---

@Anonymous wrote:

I am trying to run a macro (ExportPartslisttoExcel) on a directory of drawings.  I have started with Mod the Machine's code to print a directory of drawings to PDF.  When I copy the code to the Microsoft Visual Basic for Applications editor in Inventor I get a syntax error on the lines highlited in red.  Can anyone tell me how correct this?

Thanks in advance.

Public Sub ToExcel()

    ' Get the drawing directory to be processed
    Dim txtPath As String
    txtPath = "\\SOTAWIN2\Drafting\Projects\14-07 Seaport B\Inventor\F - Frames\"
    
    ' Get all of the drawing files in the directory and subdirectories.
    Dim drawings As String() = System.IO.Directory.GetFiles(txtPath, "*.idw", System.IO.SearchOption.AllDirectories)

    ' Iterate through the found drawings.
    For Each drawing As String In drawings
        Dim drawDoc As Inventor.DrawingDocument
        drawDoc = invApp.Documents.Open(Drawing)

        ' Export parts list info to Excel
        ExportPartslisttoExcel

        ' Close the drawing.
        drawDoc.Close (True)
    Next

End Sub

---

[Anonymous]

No luck Justin.

I still get a syntax error.

Thanks

Gary

[ekinsb · Accepted solution]

The code in the post is VB.NET.  There are differences between VB.NET and VBA.  One of the big differences is the availabilty of the .NET libraries when using VB.NET.  It's very powerful and this program uses it to get all of the files.  It's quite a bit messier when using functionality built-in to VBA.  There is a file system library that can be used but for some reason I've always just tried to make do with what's built into VBA. I've written a function using built-in functionality to traverse folders and do the equivalent of the .NET GetFiles function that the original sample is using. Below is the full VBA code. I tested it on a local directory but hopefull it will work on a remote path too.

Public Sub ToExcel()
    ' Get the drawing directory to be processed
    Dim txtPath As String
    txtPath = "\\SOTAWIN2\Drafting\Projects\14-07 Seaport B\Inventor\F - Frames\"
    
    ' Get all of the drawing files in the directory and subdirectories.
    Dim drawings() As String
    Call GetAllFiles(txtPath, "*.idw", drawings)
    
    ' Iterate through the found drawings.
    Dim i As Integer
    For i = 0 To UBound(drawings)
        Dim drawing As String
        drawing = drawings(i)
        
        Dim drawDoc As Inventor.DrawingDocument
        Set drawDoc = ThisApplication.Documents.Open(drawing)

        ' Export parts list info to Excel
        ExportPartslisttoExcel

        ' Close the drawing.
        drawDoc.Close (True)
    Next
End Sub



Public Function GetAllFiles(path As String, searchString As String, fileList() As String)
    ' Get the list of files in the current directory.
    Dim fileCount As Integer
    On Error Resume Next
    fileCount = UBound(fileList) + 1
    If Err Then
        fileCount = 0
    End If
    On Error GoTo 0
    
    Dim maxCount As Integer
    maxCount = fileCount
    Dim filename As String
    filename = Dir(path & searchString, vbNormal)
    Do While filename <> ""
        If fileCount = maxCount Then
            maxCount = fileCount + 50
            ReDim Preserve fileList(maxCount - 1)
        End If
        
        fileCount = fileCount + 1
        fileList(fileCount - 1) = path & filename
        
        filename = Dir
    Loop
    ReDim Preserve fileList(fileCount - 1)
    
    ' Build a list of the directories.
    Dim directoryList() As String
    Dim maxDirectories As Integer
    maxCount = 0
    Dim directoryCount As Integer
    directoryCount = 0
    
    Dim dirName As String
    dirName = Dir(path, vbDirectory)
    Do While dirName <> ""
        If dirName <> "." And dirName <> ".." And dirName <> "OldVersions" Then
            If (GetAttr(path & dirName) And vbDirectory) Then
                If directoryCount = maxCount Then
                    maxCount = directoryCount + 50
                    ReDim Preserve directoryList(maxCount - 1)
                End If
                
                directoryCount = directoryCount + 1
                directoryList(directoryCount - 1) = path & dirName & "\"
            End If
        End If
        
        dirName = Dir
    Loop
    
    ' Process the subdirectories.
    If directoryCount > 0 Then
        ReDim Preserve directoryList(directoryCount - 1)
        
        Dim i As Integer
        For i = 0 To UBound(directoryList)
            Call GetAllFiles(directoryList(i), searchString, fileList)
        Next
    End If
End Function

[Anonymous]

Outstanding!

Thank you very much Brian.

[Claudio_73]

Hi @ekinsb , i am working on a different macro that works in assemblies instead of drawing.

The macro works well. I change your macro for drawings (Thanks for your work). 

The macro should for each assemblies in a folder:

- Select a folder

- open .iam in that folder

- export BOM

- close .iam

The macro works well on the first .iam, but on the next .iam, something goes wrong.

I try to understand what goes wrong, by debug but...i didnt find the matter.  

Thanks in advance.

Here's the code:

Public Sub ToExcel()
' Get the drawing directory to be processed
Dim txtPath As String
'txtPath = "\\SOTAWIN2\Drafting\Projects\14-07 Seaport B\Inventor\F - Frames\"
txtPath = "C:\Users\Admin\Documents\TestMacro\"
'D:\Disegni
'D:\Disegni\2007.01.28_(Cucina Mattoni)
'D:\Disegni\2013.08.29_(Scrivania)
'C:\Users\Admin\Documents

' Get all of the drawing files in the directory and subdirectories.
Dim drawings() As String
''Call GetAllFiles(txtPath, "*.idw", drawings)
Call GetAllFiles(txtPath, "*.iam", drawings)


' Iterate through the found drawings.
Dim i As Integer
For i = 0 To UBound(drawings)
Dim drawing As String
drawing = drawings(i)

''Dim drawDoc As Inventor.DrawingDocument
Dim drawDoc As Inventor.AssemblyDocument
Set drawDoc = ThisApplication.Documents.Open(drawing)

' Export parts list info to Excel
'ExportPartslisttoExcel
'BOM_Export_Pro
'Call BOM_Export_Pro
'Application.Run ("BOM_Export_Pro")

'---TEST---


'OK---Sub BOM_Export_Pro() 'Esportazione DB completo e funzionante

Dim oApp As Application
Set oApp = ThisApplication
Dim invDoc As Document
Set invDoc = ThisApplication.ActiveDocument
Dim oDocument As Inventor.Document
Set oDocument = ThisApplication.ActiveDocument
Dim invDesignInfo As PropertySet
Set invDesignInfo = invDoc.PropertySets.Item("Design Tracking Properties")
Dim invPartNumberProperty As Property
Set invPartNumberProperty = invDesignInfo.Item("Part Number")
NumeroParte = invPartNumberProperty.Value
'Dim Estensione As String
Estensione = (".csv")
Patch = GetFilePatch(oDocument.FullFileName)
PercaorsoNomeEst = (Patch & NumeroParte & Estensione)
Peso = invDoc.ComponentDefinition.MassProperties.Mass
'Data
Dim DataCmp As String
'DataCmp = (Day(Date) & "/" & Month(Date) & "/" & Year(Date))
DataCmp = Date$
'DataCmp = (Month(Date) & "/" & Day(Date) & "/" & Year(Date))
Dim oDoc As AssemblyDocument
Set oDoc = ThisApplication.ActiveDocument
Dim oBOM As BOM
Set oBOM = oDoc.ComponentDefinition.BOM

' Imposta corrente il livello Principale
Dim oAsmDef As AssemblyComponentDefinition
Set oAsmDef = ThisApplication.ActiveDocument.ComponentDefinition
oAsmDef.RepresentationsManager.LevelOfDetailRepresentations.Item("Principale").Activate

If oApp.ActiveDocument.DocumentType = kAssemblyDocumentObject Then
Dim oAssyDoc As AssemblyDocument
Set oAssyDoc = oApp.ActiveDocument

Dim oAssyCompDef As AssemblyComponentDefinition
Set oAssyCompDef = oAssyDoc.ComponentDefinition

Dim excel_app As Excel.Application

' Setta la proprietà della vista strutturale al solo di primo livello
oBOM.StructuredViewFirstLevelOnly = True

' Attiva la vista strutturata della distinata componenti
oBOM.StructuredViewEnabled = True

' Crea l'applicazione Excel
Set excel_app = CreateObject("Excel.Application")

' Commenta questa linea se vuoi excel invisibile
excel_app.Visible = False

'Crea il foglio di lavoro
Call excel_app.Workbooks.Add
Dim oBomR As BOMRow
Dim oBOMPartNo As String

With excel_app
'.Range("A1").Select
'.ActiveCell.Value = "Padre"
'.Range("B1").Select
'.ActiveCell.Value = "Part Number"
'.Range("C1").Select
'.ActiveCell.Value = "Quantity"
'.Range("D1").Select
'.ActiveCell.Value = "Peso"

'.Range("R1").Select
'.ActiveCell.Value = "Inizio Validità"

'Iterate through parts only BOM View
Dim ii As Integer
For ii = 1 To oAssyCompDef.BOM.BOMViews(2).BOMRows.Count

'Set oBomR to current BOM Row
Set oBomR = oAssyCompDef.BOM.BOMViews(2).BOMRows(ii)

'Get Current Row part number from part
oBOMPartNo = oBomR.ComponentDefinitions(1).Document.PropertySets(3).ItemByPropId(5).Value

'oBOMPeso = oBomR.ComponentDefinitions(1).MassProperties.Mass

'Write values to spreadsheet
.Range("A" & ii + 1).Select
.ActiveCell.Value = NumeroParte
.Range("B" & ii + 1).Select
.ActiveCell.Value = oBOMPartNo
.Range("C" & ii + 1).Select
.ActiveCell.Value = oBomR.TotalQuantity 'Quantity value
'.Range("D" & ii + 1).Select
'.ActiveCell.Value = Format(oBOMPeso, "###.###")
Next ii
End With
Else
Exit Sub
End If

'Ordina le righe per ordine alfabetico secondo il codice
Sheets("Foglio1").Select
ActiveSheet.Select
Columns("A:R").Select
Range("A21").Activate
ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Foglio1").Sort.SortFields.Add Key:=Range("B2:B200") _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Foglio1").Sort
.SetRange Range("A1:R200")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

ActiveWorkbook.SaveAs filename:=(PercaorsoNomeEst), FileFormat:=xlCSVWindows, CreateBackup:=False, Local:=True
Application.DisplayAlerts = False
ActiveWorkbook.Close
excel_app.Quit 'Chiude definitivamente l'applicazione excel
MsgBox "La distinta è stata esportata correttamente!"


'End


'OK---End Sub


'---TEST---

'Salva il drawing.
drawDoc.Save

'Close the drawing.
drawDoc.Close (True)
Next
End Sub



Public Function GetAllFiles(path As String, searchString As String, fileList() As String)
' Get the list of files in the current directory.
Dim fileCount As Integer
On Error Resume Next
fileCount = UBound(fileList) + 1
If Err Then
fileCount = 0
End If
On Error GoTo 0

Dim maxCount As Integer
maxCount = fileCount
Dim filename As String
filename = Dir(path & searchString, vbNormal)
Do While filename <> ""
If fileCount = maxCount Then
maxCount = fileCount + 50
ReDim Preserve fileList(maxCount - 1)

End If

fileCount = fileCount + 1
fileList(fileCount - 1) = path & filename

filename = Dir
Loop
ReDim Preserve fileList(fileCount - 1)

' Build a list of the directories.
Dim directoryList() As String
Dim maxDirectories As Integer
maxCount = 0
Dim directoryCount As Integer
directoryCount = 0

Dim dirName As String
dirName = Dir(path, vbDirectory)
Do While dirName <> ""
If dirName <> "." And dirName <> ".." And dirName <> "OldVersions" Then
If (GetAttr(path & dirName) And vbDirectory) Then
If directoryCount = maxCount Then
maxCount = directoryCount + 50
ReDim Preserve directoryList(maxCount - 1)
End If

directoryCount = directoryCount + 1
directoryList(directoryCount - 1) = path & dirName & "\"
End If
End If

dirName = Dir
Loop

' Process the subdirectories.
If directoryCount > 0 Then
ReDim Preserve directoryList(directoryCount - 1)

Dim i As Integer
For i = 0 To UBound(directoryList)
Call GetAllFiles(directoryList(i), searchString, fileList)
Next
End If
End Function

'Funzione che estrae il percorso completo nel quale si trova il file attualmente in uso
Private Function GetFilePatch(ByVal sFullFileName As String) As String

Dim sFilePatch As String

Dim nPos1 As Integer
Dim nPosf1 As Integer
Dim nPos2 As Integer

sFilePatch = sFullFileName

nPos1 = InStrRev(sFullFileName, "\")
nPos2 = InStrRev(sFullFileName, ".")

If nPos1 > 0 Then

sFilePacth = Mid$(sFullFileName, nPos1 + 1)

End If

nPosf1 = InStr(sFullFileName, ".")

If nPos1 > 0 Then

sFilePatch = Left$(sFilePatch, nPosf1 - (nPos2 - nPos1))

End If

GetFilePatch = sFilePatch

End Function

Debug Error image: