Ideal thank you, exactly what I was looking for.
I've attached my edited version below, all I changed was the addition of an Input List box to choose your folder instead of the dialog box (purely a UI preference), and changed the properties it searched for in each drawing.
Imports Microsoft.Office.Interop.Excel
AddReference "Microsoft.Office.Interop.Excel.dll"
Sub Main
'Define main directory
Dim ofilepath As String = "C:\Work\Designs"
Dim mainDirectory As IO.DirectoryInfo = New IO.DirectoryInfo(ofilepath)
' Define a list array to store values of subfolder names & fullnames
Dim project_name As New ArrayList
Dim project_path As New ArrayList
' Loop through each folder and store names/paths in arrays
For Each folder As IO.DirectoryInfo In mainDirectory.GetDirectories()
Dim foldername As String = folder.Name.ToString
Dim folderpath As String = folder.FullName.ToString
project_name.Add(foldername)
project_path.Add(folderpath)
Next
'give input box to choose project, define selected folder to search for idw files
ArraySelected = InputListBox("Choose a Project", project_name, project_name.Item(0), "Project", "List of Active Projects", 600, 0)
If ArraySelected = "" Then
Return
End if
index = project_name.IndexOf(ArraySelected)
Searchpath = project_path(index)
'get reference to active Inventor application object one time, then use this variable later
Dim oInvApp As Inventor.Application = ThisApplication
'specify the prompt to show the user within the file dialog, when it shows
Dim sDialogPrompt As String = "Choose folder to create Excel report for."
'run our custom Function to allow user to use a file dialog to select a folder.
Dim sFolder As String = Searchpath
'check if anything was returned, and if something was returned, make sure it is valid
If sFolder = "" Then
MsgBox("Empty path returned for Folder. Exiting rule.", vbCritical, "iLogic")
Return 'this exits out of this current Sub routine
ElseIf IsValidPath(sFolder) = False Then
MsgBox("Specified Folder path was not valid. Exiting rule.", vbCritical, "iLogic")
Return
End If
'make sure that folder exists
If System.IO.Directory.Exists(sFolder) = False Then
MsgBox("Specified Folder does not exist. Exiting rule.", vbCritical, "iLogic")
Return
End If
'Dim oDirectoryInfo As New System.IO.DirectoryInfo(sFolder)
'get an Array of Strings containing the full file names of every file in this folder with ".idw" file extension
Dim sFileExtensionsFilter As String = "*.idw"
Dim oFiles() As String = {}
Try
oFiles = System.IO.Directory.GetFiles(sFolder, sFileExtensionsFilter, System.IO.SearchOption.TopDirectoryOnly)
Catch
MsgBox("Error getting the files from within the specified folder!", vbCritical, "iLogic")
End Try
Dim iFiles As Integer = oFiles.Length
'make sure we found some files like that in that folder...if not, exit this rule
If oFiles Is Nothing OrElse iFiles = 0 Then
MsgBox("No IDW drawing files found in that folder. Exiting rule.", vbCritical, "iLogic")
Return
End If
'declare a collection type variable to hold all the data we want to record
Dim oDataList As New List(Of List(Of String))
'define column headers as first entry into that data
Dim oColumnHeaders As New List(Of String) From {"PART NUMBER", "Revision Number", "DRW", "Checked", "Approved" }
'add the column headers to the main collection, as its first entry
oDataList.Add(oColumnHeaders)
'define options for what should happen when opening the drawings
Dim oOpenArgs As Inventor.NameValueMap = oInvApp.TransientObjects.CreateNameValueMap
oOpenArgs.Add("DeferUpdates", True)
oOpenArgs.Add("FileVersionOption", FileVersionEnum.kOpenCurrentVersion)
oOpenArgs.Add("SkipAllUnresolvedFiles", True)
'create the 'ProgressBar' and provide starting information to it
oProgressBar = oInvApp.CreateProgressBar(False, iFiles, "Searching Files", True)
'create a variable to keep track of which 'step' we are on, for 'Progress' purposes
Dim iFile As Integer = 0
'call our custom routine to initialize / update the ProgressBar
UpdateProgressBarMessage(0, iFiles)
'iterate through those this array of full file names
For Each sFile In oFiles
'check if the ProgressBar has been canceled. If so, then exit this loop immediately.
If bProgressBarCancelled = True Then
oProgressBar.Close()
Exit For
ElseIf iFile >= iFiles Then
oProgressBar.Close()
End If
iFile += 1 'adds 1 to its current value (for 'Progress' tracking purposes)
'let the ProbressBar know which step we are about to process
UpdateProgressBarMessage(iFile, iFiles)
'declare variable to hold the Document we will be opening
Dim oDDoc As DrawingDocument = Nothing
'try to open that Document, based on the FullFileName, using the Options established
Try
oDDoc = oInvApp.Documents.OpenWithOptions(sFile, oOpenArgs, False) 'False = not visible
Catch
MsgBox("Error opening following drawing file." & vbCrLf & sFile, vbCritical, "iLogic")
End Try
If oDDoc Is Nothing Then Continue For 'skip to next 'sFile', if any
'get Part Number iProperty value
Dim sPN As String = oDDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
If sPN = "" Then
'we could still write the empty string to the cell in Excel, or we could omit this file
End If
'get REV NUmber iProperty value
Dim sRN As String = oDDoc.PropertySets.Item("Inventor Summary Information").Item("Revision Number").Value
If sRN = "" Then
'we could still write the empty string to the cell in Excel, or we could omit this file
End If
'get DRW iProperty value
Dim customPR As PropertySet
customPR = oDDoc.PropertySets.Item("Inventor User Defined Properties")
Dim sDRW As String
Try
sDRW = customPR.Item("DRW").Value
Catch
sDRW = ""
End Try
'get CHKD iProperty value
Dim sCHKD As String
Try
sCHKD = customPR.Item("CHKD").Value
Catch
sCHKD = ""
End Try
'get APPD iProperty value
Dim sAPPD As String
Try
sAPPD = customPR.Item("APPD").Value
Catch
sAPPD = ""
End Try
'create a new List(Of String), and add these pieces of data to it
Dim oRowData As New List(Of String) From {sPN, sRN, sDRW, sCHKD, sAPPD }
'add that new List(Of String) to the main data collection
oDataList.Add(oRowData)
Next sFile
'make sure the ProgressBar gets closed if Progress is finished
If iFile >= iFiles Then : Try : oProgressBar.Close() : Catch : End Try : End If
'convert List(Of List(Of String)) Into a 2-dimensional Array of Strings [ String() ]
Dim iRowsOfData As Integer = oDataList.Count
Dim iColumnsOfData As Integer = oDataList.Item(0).Count
Dim oDataArray((iRowsOfData - 1), (iColumnsOfData - 1))
For iRow As Integer = 0 To (iRowsOfData - 1)
For iColumn As Integer = 0 To (iColumnsOfData - 1)
oDataArray(iRow, iColumn) = oDataList.Item(iRow).Item(iColumn)
Next iColumn
Next iRow
'now we need to write the data we collected from those files into an Excel file.
Write2DArrayOfDataToExcel(oDataArray)
End Sub
Dim WithEvents oProgressBar As Inventor.ProgressBar
Dim bProgressBarCancelled As Boolean
Function SelectFolder(Optional sPrompt As String = vbNullString) As String
If String.IsNullOrEmpty(sPrompt) Then sPrompt = "Select Folder"
Dim oResult As System.Windows.Forms.DialogResult
Dim sPath As String
Using oFDialog As New System.Windows.Forms.FolderBrowserDialog()
oFDialog.Description = sPrompt
oFDialog.ShowNewFolderButton = True
Dim designsfolder As String = "C:\Work\Designs\BP-46 BP Machar W122 Re-Entry Hub Removal Tooling"
oFDialog.SelectedPath = designsfolder
'oFDialog.RootFolder = System.Environment.SpecialFolder.MyComputer
oResult = oFDialog.ShowDialog()
sPath = oFDialog.SelectedPath
End Using
If oResult = System.Windows.Forms.DialogResult.OK Then
Return sPath
Else 'if dialog was canceled or something else
Return String.Empty
End If
End Function
Function IsValidPath(ByVal sPath As String) As Boolean
If sPath Is Nothing OrElse sPath = "" Then Return False
If sPath.Intersect(System.IO.Path.GetInvalidPathChars()).Any() Then Return False
Return True
End Function
Sub Write2DArrayOfDataToExcel(oData(, ) As Object)
Dim oExcel As Object = Nothing
Try : oExcel = GetObject("Excel.Application") : Catch : End Try
If oExcel Is Nothing Then
Try : oExcel = CreateObject("Excel.Application") : Catch : End Try
End If
If oExcel Is Nothing Then
MsgBox("Could not obtain an instance of the Excel application to work with!", vbCritical, "iLogic")
Return
End If
If Not TypeOf oExcel Is Microsoft.Office.Interop.Excel.Application Then
Try
oExcel = DirectCast(oExcel, Microsoft.Office.Interop.Excel.Application)
Catch
MsgBox("Error: Could not 'Cast' obtained Excel object to 'Excel.Application' Type!", vbCritical, "iLogic")
End Try
End If
oExcel.Visible = True
oExcel.DisplayAlerts = True
Dim oWB As Object = Nothing
Try
oWB = oExcel.Workbooks.Add()
Catch
Logger.Error("Error adding a new Workbook in Excel!")
End Try
If oWB Is Nothing Then
MsgBox("Could not create a new Workbook in Excel to write the data to!", vbCritical, "iLogic")
Return
End If
Dim oWS As Object = Nothing
Try
oWS = oWB.Worksheets.Add()
Catch
Logger.Error("Error adding a new Worksheet in Excel!")
End Try
If oWS Is Nothing Then
MsgBox("Could not create a new Worksheet in Excel to write the data to!", vbCritical, "iLogic")
Return
End If
Dim iRow As Integer = oData.GetLength(0)
oWS.Range("A1", "E" & iRow.ToString).Value = oData
oWS.Columns.AutoFit()
oWS.Name = "INVENTOR DRAWINGS"
For Each oOtherWS In oWB.Worksheets
If oOtherWS IsNot oWS Then oOtherWS.Delete()
Next oOtherWS
oWS = Nothing
oWB = Nothing
oExcel = Nothing
End Sub
Sub UpdateProgressBarMessage(Optional iStep As Integer = 0, Optional iSteps As Integer = 0)
oProgressBar.UpdateProgress()
oProgressBar.Message = "Working on " & iStep & " of " & iSteps & " files."
End Sub
Sub OnCancelProgressBar() Handles oProgressBar.OnCancel
bProgressBarCancelled = True
oProgressBar.Message = "Stopping progress, due to cancelation."
oProgressBar.Close()
End Sub
