AnsweredAssumed Answered

Macro filename manipulation

Question asked by Eghard Kolste on Aug 11, 2015

Hey there,


I am using a macro from my former colleague and this macro creates perfect PDF's, but for the DXF's it adds "00_...." and "01_..." in front of the filename if the file has more than one sheet. I would like to add the sheetname at the back of the filename. Filename is the same as the part number and I want the output file named as "part number_sheet 1.dxf" and so on. How can I manage that with the existing macro?


Thanks in advance!







Option Explicit

    Dim swApp                   As SldWorks.SldWorks

    Dim swModel                 As SldWorks.ModelDoc2

    Dim sPathName               As String

    Dim nErrors                 As Long

    Dim nWarnings               As Long

    Dim nRetval                 As Long

    Dim bShowMap                As Boolean

    Dim swModelDocExt           As SldWorks.ModelDocExtension

    Dim swExportData            As SldWorks.ExportPdfData

    Dim filename                As String

    Dim boolstatus              As Boolean

    Dim lErrors                 As Long

    Dim lWarnings               As Long

    Dim bRet                    As Boolean


Sub main()

    Set swApp = Application.SldWorks

    Set swModel = swApp.ActiveDoc



    ' Strip off SolidWorks drawing file extension (.slddrw)

    ' and add DXF file extension (.dxf)

    sPathName = swModel.GetPathName

    sPathName = Left(sPathName, Len(sPathName) - 6)

    sPathName = sPathName + "dxf"

    ' Show current settings





    ' Turn off showing of map

    bShowMap = swApp.GetUserPreferenceToggle(swDXFDontShowMap)

    Set swModelDocExt = swModel.Extension

    Set swExportData = swApp.GetExportFileData(swExportPDFData)

    filename = swModel.GetPathName

    filename = Strings.Left(filename, Len(filename) - 6) & "PDF"

    boolstatus = swExportData.SetSheets(swExportData_ExportAllSheets, 1)

    boolstatus = swModelDocExt.SaveAs(filename, 0, 0, swExportData, lErrors, lWarnings)

    If boolstatus Then

        MsgBox "Save as PDF DXF in same directory was successful, Eghard Kolste!" & vbNewLine & filename


        MsgBox "Save as PDF failed something went wrong, Error code:" & lErrors '

    End If

    swApp.SetUserPreferenceToggle swDXFDontShowMap, False



    bRet = swModel.SaveAs4(sPathName, swSaveAsCurrentVersion, swSaveAsOptions_Silent, nErrors, nWarnings)

    If bRet = False Then

        nRetval = swApp.SendMsgToUser2("Problems saving file.", swMbWarning, swMbOk)

    End If

    ' Restore old setting

    swApp.SetUserPreferenceToggle swDXFDontShowMap, bShowMap

End Sub