19 Replies Latest reply on Jan 30, 2018 1:12 PM by Jeffrey Farless

    Save As PDF macro, how to save one or two directories back?

    Shaun Jalbert

      I found a macro online for performing a "save as PDF", but it saves the file under the current working directory. The way our file structure is set up, we have a folder named "PDF" typically one to two directories back. Is there a way to manipulate the existing code so it drops the files under the correct directory?

       

      Here's the existing code:

       

      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 + "pdf"

       

         

          ' Show current settings

       

          Debug.Print "DxfMapping             = " & swApp.GetUserPreferenceToggle(swDxfMapping)

       

          Debug.Print "DXFDontShowMap         = " & swApp.GetUserPreferenceToggle(swDXFDontShowMap)

         

       

          Debug.Print "DxfVersion             = " & swApp.GetUserPreferenceIntegerValue(swDxfVersion)

       

          Debug.Print "DxfOutputFonts         = " & swApp.GetUserPreferenceIntegerValue(swDxfOutputFonts)

       

          Debug.Print "DxfMappingFileIndex    = " & swApp.GetUserPreferenceIntegerValue(swDxfMappingFileIndex)

       

          Debug.Print "DxfOutputLineStyles    = " & swApp.GetUserPreferenceIntegerValue(swDxfOutputLineStyles)

       

          Debug.Print "DxfOutputNoScale       = " & swApp.GetUserPreferenceIntegerValue(swDxfOutputNoScale)

             

       

          Debug.Print "DxfMappingFiles        = " & swApp.GetUserPreferenceStringListValue(swDxfMappingFiles)

       

         

          Debug.Print "DxfOutputScaleFactor   = " & swApp.GetUserPreferenceDoubleValue(swDxfOutputScaleFactor)

       

          Debug.Print ""

             

       

          ' Turn off showing of map

       

          bShowMap = swApp.GetUserPreferenceToggle(swDXFDontShowMap)

       

          Debug.Print "bShowMap = " & bShowMap

         

          swApp.SetUserPreferenceToggle swDXFDontShowMap, False

       

             

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

          Beep

       

          If bRet = False Then

       

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

       

          End If

       

          ' Restore old setting

       

          swApp.SetUserPreferenceToggle swDXFDontShowMap, bShowMap

       

      End Sub

       

      '----------------------------------------------

        • Re: Save As PDF macro, how to save one or two directories back?
          Deepak Gupta

          Replace these lines

                      sPathName = swModel.GetPathName

           

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

           

              sPathName = sPathName + "pdf"

          With

           

               Dim sFileName As String

              sFileName = Mid(swModel.GetPathName, InStrRev(swModel.GetPathName, "\") + 1)

              sFileName = Left(sFileName, InStrRev(sFileName, ".") - 1)

             

              sPathName = Left(swModel.GetPathName, InStrRev(swModel.GetPathName, "PDF\") + 3)

              sPathName = sPathName & sFileName & ".PDF"

          • Re: Save As PDF macro, how to save one or two directories back?
            Keith Rice

            This will save the the current model with a new extension up a certain number of directories from the current model directory. The new extension and number of directories above are specified in the constants at top.

             

            Const DIR_ABOVE As Integer = 2
            Const NEW_EXTENSION As String = "PDF"
            
            Sub main()
                Dim swApp As SldWorks.SldWorks
                Dim swModel As SldWorks.ModelDoc2
                
                Set swApp = Application.SldWorks
                Set swModel = swApp.ActiveDoc
                
                ' Create new file name
                Dim strModelPath As String
                Dim strSavePath As String
                Dim strFileName As String
                Dim vSplit As Variant
                
                strModelPath = swModel.GetPathName
                strFileName = Right(strModelPath, Len(strModelPath) - InStrRev(strModelPath, "\"))
                vSplit = Split(strFileName, ".")
                strFileName = vSplit(0) & "." & NEW_EXTENSION
                
                ' Create new directory
                vSplit = Split(strModelPath, "\")
                
                Dim i As Integer
                For i = 0 To UBound(vSplit) - DIR_ABOVE - 1
                    strSavePath = strSavePath & vSplit(i) & "\"
                Next i
                strSavePath = strSavePath & strFileName
                
                Debug.Print "Original path: " & strModelPath
                Debug.Print "New save path: " & strSavePath
                
                ' Save
                bRet = swModel.Extension.SaveAs(strSavePath, swSaveAsCurrentVersion, _
                    swSaveAsOptions_Silent, Nothing, Empty, Empty)
            
                If bRet = False Then swApp.SendMsgToUser "Problems saving file."
            End Sub
            

             

            Keith

            SolidWorks API Training

              • Re: Save As PDF macro, how to save one or two directories back?
                Shaun Jalbert

                Thanks for reply Keith, I didn't try this code, because it sounds like it only saves the file "x" number of directories back.

                I need it to go back "x" number of directories until it finds the folder named "04 PDFs" and then saves the PDF under that directory.

                  • Re: Save As PDF macro, how to save one or two directories back?
                    Ivana Kolin

                    then change this piece of code

                     

                    1.     For i = 0 To UBound(vSplit)  - 1 
                    2.         strSavePath = strSavePath & vSplit(i) & "\" 
                    3.         If dir(strSavePath & "04 PDFs", vbDirectory) <> "" then
                    4.        strSavePath = strSavePath & "04 PDFs &"\"
                    5.         exit for
                    6.         end if
                    7.     Next i 
                      • Re: Save As PDF macro, how to save one or two directories back?
                        Shaun Jalbert

                        Hi Ivana:

                        Thanks for the suggestion. I swapped the code you recommended but still no cigar, but it was closer.

                         

                        The file ended up saving to:

                        C:\EPDM_Vault\Projects\101046\01 SolidWorks\

                         

                        But, I need it to go here

                        C:\EPDM_Vault\Projects\101046\04 PDFs\

                         

                        Any more suggestions?

                         

                         

                        '------------------------------------------------------------------

                        '

                        ' Preconditions: Drawing file is open.

                        '

                        ' Postconditions: DXF file is generated, overwriting any existing file.

                        '

                        '------------------------------------------------------------------

                        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 bRet                    As Boolean

                         

                            Const DIR_ABOVE As Integer = 2

                            Const NEW_EXTENSION As String = "PDF"

                             

                            Sub main()

                                Dim swApp As SldWorks.SldWorks

                                Dim swModel As SldWorks.ModelDoc2

                                 

                                Set swApp = Application.SldWorks

                                Set swModel = swApp.ActiveDoc

                                 

                                ' Create new file name

                                Dim strModelPath As String

                                Dim strSavePath As String

                                Dim strFileName As String

                                Dim vSplit As Variant

                                 

                                strModelPath = swModel.GetPathName

                                strFileName = Right(strModelPath, Len(strModelPath) - InStrRev(strModelPath, "\"))

                                vSplit = Split(strFileName, ".")

                                strFileName = vSplit(0) & "." & NEW_EXTENSION

                                 

                                ' Create new directory

                                vSplit = Split(strModelPath, "\")

                                 

                                Dim i As Integer

                            For i = 0 To UBound(vSplit) - DIR_ABOVE - 1

                                    strSavePath = strSavePath & vSplit(i) & "\"

                                    If Dir(strSavePath & "04 PDFs") <> "" Then

                            strSavePath = strSavePath & "04 PDFs &" \ ""

                            Exit For

                            End If

                                Next i

                                strSavePath = strSavePath & strFileName

                                 

                                Debug.Print "Original path: " & strModelPath

                                Debug.Print "New save path: " & strSavePath

                                 

                                ' Save

                                bRet = swModel.Extension.SaveAs(strSavePath, swSaveAsCurrentVersion, _

                                    swSaveAsOptions_Silent, Nothing, Empty, Empty)

                             

                                If bRet = False Then swApp.SendMsgToUser "Problems saving file."

                            End Sub

                          • Re: Save As PDF macro, how to save one or two directories back?
                            Ivana Kolin

                            this is wrong, I am typing on iPad, so I can't check syntax

                            strSavePath = strSavePath & "04 PDFs &" \ ""

                            it has to be : strSavePath = strSavePath & "04 PDFs\"

                              • Re: Save As PDF macro, how to save one or two directories back?
                                Shaun Jalbert

                                I fixed that and still no go.

                                It looks like it's going back up the folders until it can see the directory "04 PDFs\",

                                but then dumps the file under the last working directory "01 SoldWorks\" instead of then dumping it in "04 PDFs\"

                                But I don't know any better...

                                 

                                Any other suggestions?

                                  • Re: Save As PDF macro, how to save one or two directories back?
                                    Jim Sculley

                                    If you can, consider switching from VBA to VB.NET or C#.  You have much more powerful APIs at your disposal that can eliminate all of the ugly hacking and slashing of strings:

                                     

                                                ModelDoc2 mDoc = swApp.ActiveDoc as ModelDoc2;
                                                string filePath = mDoc.GetPathName();
                                                string filenameWithoutExtension = Path.GetFileNameWithoutExtension(filePath);
                                                DirectoryInfo parentDirInfo = new DirectoryInfo(filePath);
                                                while (parentDirInfo != null && !parentDirInfo.Name.Equals("04 PDFs"))
                                                {
                                                    parentDirInfo = parentDirInfo.Parent;
                                                }
                                                if (parentDirInfo == null)
                                                {
                                                    MessageBox.Show("No parent PDF directory found");
                                                    return;
                                                }
                                                string newFileName = parentDirInfo.FullName + Path.DirectorySeparatorChar + filenameWithoutExtension + ".pdf";
                                                ExportPdfData exportData = swApp.GetExportFileData((int)swExportDataFileType_e.swExportPdfData) as ExportPdfData;
                                                exportData.ExportAs3D = false;
                                                exportData.SetSheets((int)swExportDataSheetsToExport_e.swExportData_ExportAllSheets, null);
                                                int errors = 0;
                                                int warnings = 0;
                                                ModelDocExtension mDocExt = mDoc.Extension;
                                                mDocExt.SaveAs(newFileName, (int)swSaveAsVersion_e.swSaveAsCurrentVersion, 0, exportData, ref errors, ref warnings);
                                                if (errors != 0)
                                                {
                                                    MessageBox.Show("Errors saving PDF: " + errors);
                                                }
                                                if (warnings != 0)
                                                {
                                                    MessageBox.Show("Warnings saving PDF: " + warnings);
                                                }
                                    
                            • Re: Save As PDF macro, how to save one or two directories back?
                              Keith Rice

                              This will find a folder called FOLDER_NAME in one of the parent directories, starting with the root directory and working forward.

                               

                              Const NEW_EXTENSION As String = "PDF"
                              Const FOLDER_NAME As String = "04 PDFs"
                              
                              Sub main()
                                  
                                  If FOLDER_NAME = Empty Then Exit Sub
                                  
                                  Dim swApp As SldWorks.SldWorks
                                  Dim swModel As SldWorks.ModelDoc2
                                  
                                  Set swApp = Application.SldWorks
                                  Set swModel = swApp.ActiveDoc
                                  
                                  ' Create new file name
                                  Dim strModelPath As String
                                  Dim strSavePath As String
                                  Dim strSaveFolder As String
                                  Dim strFileName As String
                                  Dim vSplit As Variant
                                  
                                  strModelPath = swModel.GetPathName
                              
                                  If swModel.GetPathName = Empty Then
                                      swApp.SendMsgToUser "Please save model."
                                      Exit Sub
                                  End If
                              
                                  strFileName = Right(strModelPath, _
                                      Len(strModelPath) - InStrRev(strModelPath, "\"))
                                  vSplit = Split(strFileName, ".")
                                  strFileName = vSplit(0) & "." & NEW_EXTENSION
                                  
                                  ' Create new directory
                                  vSplit = Split(strModelPath, "\")
                                  
                                  Dim intDirAbove As Integer
                                  Dim i As Integer
                                  Dim bFound As Boolean
                                  
                                  bFound = False
                                  
                                  For i = 0 To UBound(vSplit) - intDirAbove
                                      strSaveFolder = strSaveFolder & vSplit(i) & "\"
                                      
                                      If Dir(strSaveFolder & FOLDER_NAME, vbDirectory) <> Empty Then
                                          bFound = True
                                          Exit For
                                      End If
                                      
                                  Next i
                                  
                                  If bFound = False Then
                                      swApp.SendMsgToUser "Failed to find correct folder."
                                      Exit Sub
                                  End If
                                  
                                  strSavePath = strSaveFolder & FOLDER_NAME & "\" & strFileName
                                  
                                  Debug.Print "Original path: " & strModelPath
                                  Debug.Print "New save path: " & strSavePath
                                  
                                  ' Save
                                  bRet = swModel.Extension.SaveAs(strSavePath, swSaveAsCurrentVersion, _
                                      swSaveAsOptions_Silent, Nothing, Empty, Empty)
                                  
                                  If bRet = False Then swApp.SendMsgToUser "Problems saving file."
                              End Sub
                              

                               

                              Keith

                              SolidWorks API Tutorials