How to perform 'save a copy as' PDF for a list of Inventor drawings from an excel using VBA?

[shuaib_cad]

I have list of Inventor drawings in an excel. I want to convert them as PDFs with their respective names in a specific location using excel VBA.

Regards,

Mohammed Shuaib K

[JelteDeJong]

if you want to go to iLogic it would be more easy and you can do the following:

Dim excelFileName As String = "C:\temp\files.xlsx" '<- Excel name
Dim excelSheetName As String = "Sheet1" '<- Excel sheet/tab name
Dim collumn As String = "A" '<- column with filenames
Dim rowNr As Integer = 1 '<- first row with filenames

GoExcel.Open(excelFileName, excelSheetName)
Dim fileName As String = GoExcel.CellValue(collumn & rowNr)
While String.IsNullOrEmpty(fileName) = False
	Try
		Dim doc As DrawingDocument = ThisApplication.Documents.Open(fileName)
		Dim pdfFileName = IO.Path.ChangeExtension(doc.FullFileName, ".pdf")
		' MsgBox(pdfFileName)
		doc.SaveAs(pdfFileName, True)
		doc.Close()
    Catch ex As Exception
		MsgBox("Trouble in paradise while saving file: " & fileName)
    End Try
	rowNr = rowNr+1
	fileName = GoExcel.CellValue(collumn & rowNr)
End While

[Eide.N]

@JelteDeJong Is there a way to open a file if you don't know the path, just the filename?

Thanks for all you do, helping us with your iLogic skills!

[WCrihfield]

@Eide.N 

Yes. It is possible but will take a longer time to process.  Basically the code would have to search within all directories under your current Workspace directory for a file with that name (for each file), before it can open the file, then save (or export) it to a PDF.  Hopefully there aren't multiple files with the same file name within those directories, or it may cause problems.  Would you need that code in iLogic, VBA, or other?

[WCrihfield]

Here is a VBA macro you can try.  It doesn't search through your Workspace directories for the drawing document, so if your list of drawing names doesn't include the full file name (path and file name, with extension) it won't work yet.  It just uses the simple SaveAs technique, instead of going through the true export process, so there isn't any options to specify.

Things you may have to edit before running it.

• The value of oXLFile.  Change it to the full file name (with path and extension) of your source Excel file.
• The value of oSLSheet.  Make sure this is the name of the sheet (or tab) in your Excel file, where the names are listed.
• The value of oCol.  Make sure this is the Column in that sheet where the drawing names are listed.
• The value of o1stRow.  Make sure this is set to the first row number where the names start.
• Make sure you are referencing the Microsoft Excel (version number) Object Library.
  • In the VBA Editor, go to Tools tab, References..., scroll list to find this, then check the box next to it, then click OK button.
• If this process of starting Excel doesn't work for you, there are other ways to do it that may work better for you.  I have a list of them if needed.  This works for me, though.

Here's the code.

Sub PDF_List_Of_Drawings_From_Excel()
    Dim oXLFile As String
    oXLFile = "C:\Temp\Test.xlsx"
    Dim oXLSheet As String
    oXLSheet = "Sheet1"
    Dim oCol As String
    oCol = "A"
    Dim oRow As Integer
    o1stRow = 1
    
    'Create New instance of the Excel application
    Dim oExcel As Excel.Application
    Set oExcel = New Excel.Application
    oExcel.DisplayAlerts = False
    oExcel.Visible = True
    
    'Open the Workbook (file)
    Dim oWB As Excel.Workbook
    Set oWB = oExcel.Workbooks.Open(oXLFile)
    
    'Get the Worksheet (Sheet or Tab)
    Dim oWS As Excel.WorkSheet
    Set oWS = oWB.Worksheets.Item(oXLSheet)
    
    Dim oDrgName As String
    
    Dim oRow As Integer
    Dim oLastRowUsed As Integer
    oLastRowUsed = oWS.UsedRange.Rows.Count
    
    For oRow = o1stRow To oLastRowUsed
        'Check to see if the cell is empty
        If oWS.Range(oCol & oRow).Value = Nothing Or oWS.Range(oCol & oRow).Value = vbNullString Then
            Next oRow
        Else
            oDrgName = oWS.Range(oCol & oRow).Value
        End If

        'Could search for this file in the Workspace directories here
        'before proceeding, if needed.

        Dim oDDoc As DrawingDocument
        
        On Error GoTo Open_Failed
        Set oDDoc = ThisApplication.Documents.Open(oDrgName)
        Dim oPDFName As String
        oPDFName = IO.Path.ChangeExtension(oDDoc.FullFileName, ".pdf")
        On Error GoTo PDF_Failed
        Call oDDoc.SaveAs(oPDFName, True)
        Call oDDoc.Close
        GoTo NextRow
Open_Failed:
        Call MsgBox("Failed Open:  " & oDrgName, vbOKOnly + vbCritical, " ")
        GoTo NextRow
PDF_Failed:
        Call MsgBox("Failed save PDF:  " & oPDFName, vbOKOnly + vbCritical, " ")
        GoTo NextRow
NextRow:
        oRow = oRow + 1
        oDrgName = oWS.Range(oCol & oRow).Value
    Next oRow
    oWB.Close
    oExcel.Quit
End Sub

If this solved your problem, or answered your question, please click ACCEPT SOLUTION.
Or, if this helped you, please click 'LIKE' 👍.

If you have time, please... Vote For My IDEAS 💡and Explore My CONTRIBUTIONS

Inventor 2021 Help | Inventor Forum | Inventor Customization Forum | Inventor Ideas Forum

[JelteDeJong]

As mentioned searching for a file can be very time consuming. But if you want this is how you can do it.

Dim searchFolder As String = "C:\temp\" '<- search in this folder (and sub folders)
Dim excelFileName As String = "files.xlsx" '<- Excel name
Dim excelSheetName As String = "Sheet1" '<- Excel sheet/tab name
Dim collumn As String = "A" '<- column with filenames
Dim rowNr As Integer = 1 '<- first row with filenames

Dim startFolder As IO.DirectoryInfo = New IO.DirectoryInfo(searchFolder)
Dim xlsFiles As IO.FileInfo() = startFolder.GetFiles("files.xlsx", IO.SearchOption.AllDirectories)
If (xlsFiles.Count <> 1) Then
	MsgBox("Could not find Excel file")
	Return
End If
excelFileName = xlsFiles(0).FullName

GoExcel.Open(excelFileName, excelSheetName)
Dim fileName As String = GoExcel.CellValue(collumn & rowNr)
While String.IsNullOrEmpty(fileName) = False
	Try
		Dim doc As DrawingDocument = ThisApplication.Documents.Open(fileName)
		Dim pdfFileName = IO.Path.ChangeExtension(doc.FullFileName, ".pdf")
		' MsgBox(pdfFileName)
		doc.SaveAs(pdfFileName, True)
		doc.Close()
    Catch ex As Exception
		MsgBox("Trouble in paradise while saving file: " & fileName)
    End Try
	rowNr = rowNr+1
	fileName = GoExcel.CellValue(collumn & rowNr)
End While

[Eide.N]

Thanks guys! What an amazing group of smart people we have here.