7 Replies Latest reply on Dec 22, 2014 4:58 PM by Dallas Havens

    Save as PDF but check for open document first

    Dallas Havens

      I have compiled some code from several posts on this forum to create a macro that will save a document and then if the document is a drawing save a PDF file in the same location. The macro works great but the only problem is that if the pdf file already exists and is open by me or another user it hangs up until the file is closed.

       

      Is there a way to check to see if there is a pdf by the same name already open by someone and bring up a dialog box that will notify the user and give a choice to either continue or exit?

       

      Attached is the macro I am currently using.

       

      Thanks in advance for any help you may provide.

       

      Message was edited by: Dallas Havens

        • Re: Save as PDF but check for open document first
          Daniel Andersson

          Hi,

           

          Check out this information an code from Microsoft. Macro code to check whether a file is already open

          As an option, this information is also available from Microsoft. WD2000: VBA Function to Check Whether File or Document Is Open

           

          Next thing to add is a messagebox with option, vbOkCancel to get a Ok and Cancel button.

          That part of the code look like this...

           

          Dim iRetVal As Integer

          iRetVal = MsgBox("Text goes here..." & "Another text string", vbOkCancel)

           

          If iRetVal = 1 Then

               'User clicked Ok at messagebox

           

          Else

               'User clicked Cancel at messagebox

           

          End If

          You may also choose if a icon should appear in the message box:

          iRetVal = MsgBox("Text goes here..." & "Another text string", vbOkCancel + vbInformation)

           

          Alternatives to vbInformation is vbCritical, vbQuestion and vbExclamation

           

          You may also set a title to the dialog:

          iRetVal = MsgBox("Text goes here..." & "Another text string", vbOkCancel, "Your title")

           

          For further information about MsgBox, see the help file in the VBA editor.

           

          Please let me know if you need any further help.

            • Re: Save as PDF but check for open document first
              Dallas Havens

              Hi Daniel,

               

              Thanks for the info, I will look into it.

              • Re: Save as PDF but check for open document first
                Dallas Havens

                Hi Daniel,

                 

                I know that it has been a few days since I posted but I've been working on another project. This is a bit of a side pet project but I have very little experience writing code. I used the info you provided above to modify my code to try and get it to check to see if the PDF is open before it saves. I also added the code you provided to bring up the message box and I attempted to use a loop to have it recheck for the open file upon clicking ok.

                 

                The problem is that when I run the macro I get a compile error on the "IsFileOpen" command. It says "Sub or Function not defined". I have coppied the modified macro below.

                 

                As I said before, I have very little experience writing code so any help that you will be willing to give will be greatly appreciated.

                 

                Thanks in advance.

                 

                'File Save As PDF & DWG.swp -------------03/18/13

                 

                'Description: Macro to save active drawing as PDF and DWG.
                'Precondition: Any active drawing to be saved.
                'Postcondition: Active drawing will be saved as PDF and DWG in the same location as drawing.

                ' Please back up your data before use and USE AT OWN RISK

                ' This macro is provided as is.  No claims, support, refund, safety net, or
                ' warranties are expressed or implied.  By using this macro and/or its code in
                ' any way whatsoever, the user and any entities which the user represents,
                ' agree to hold the authors free of any and all liability.  Free distribution
                ' and use of this code in other free works is welcome.  If any portion of
                ' this code is used in other works, credit to the authors must be placed in
                ' that work within a user viewable location (e.g., macro header).  All other
                ' forms of distribution (i.e., not free, fee for delivery, etc) are prohibited
                ' without the expressed written consent by the authors.  Use at your own risk!
                ' ------------------------------------------------------------------------------
                ' Written by: Deepak Gupta (http://gupta9665.wordpress.com/)
                ' -------------------------------------------------------------------------------

                 

                Dim swApp        As SldWorks.SldWorks
                Dim swModel      As SldWorks.ModelDoc2
                Dim swDraw       As SldWorks.DrawingDoc
                Dim Filepath     As String
                Dim FileName     As String
                Dim boolstatus As Boolean
                Dim longstatus As Long, longwarnings As Long

                Sub main()

                Set swApp = Application.SldWorks
                Set swModel = swApp.ActiveDoc

                ' Is document active?

                If swModel Is Nothing Then

                    swApp.SendMsgToUser2 "A document must be active.", swMbWarning, swMbOk

                    Exit Sub

                End If

                'Save Document

                swModel.Save

                ' Is it a Drawing document?

                If swModel.GetType <> swDocDRAWING Then

                    Exit Sub
                   
                End If

                Set swDraw = swModel

                Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

                FileName = Left(swDraw.GetTitle, Len(swDraw.GetTitle) - 9)

                    ' Test to see if the file is open.
                    Do
                    If IsFileOpen(Filepath + FileName + ".PDF") Then
                        ' Display a message stating the file in use.
                        Dim iRetVal As Integer

                        iRetVal = MsgBox(Filepath + FileName + ".PDF is in use by you or another user." & "Make sure the file is no longer open" & "or click cancel to exit without updating PDF file.", vbOKCancel)
                        If iRetVal = 1 Then
                         'User clicked Ok at messagebox
                            Loop
                        Else
                         'User clicked Cancel at messagebox
                            End Sub
                        End If
                        '
                        ' Add code here to handle case where file is open by another
                        ' user.
                        '
                    Else
                        ' Display a message stating the file is not in use.
                        MsgBox "File not in use!"
                        ' Save document as PDF.
                        swDraw.SaveAs (Filepath + FileName + ".PDF")
                        '
                        ' Add code here to handle case where file is NOT open by another
                        ' user.
                        '
                    End If
                   
                End Sub

              • Re: Save as PDF but check for open document first
                Charles Winter

                Here is the part of our code that checks that.

                 

                 

                 

                 

                iResponse = MsgBox("The PDF will be saved to..." + Chr(13) + FileSave + Chr(13) + Chr(13) + "Is this correct?", vbYesNo + vbQuestion, "PDF will be saved to...")

                    If iResponse = vbNo Then

                        errorfinish = True

                        GoTo Finish

                    Else

                    End If

                    ' Checks if PDF file already exist in the directory

                    Set fso = CreateObject("Scripting.FileSystemObject")

                    If fso.FileExists(FileSave) = True Then

                        iResponse = MsgBox("A PDF for '" & Filename & "' already exist, are you sure you want to overwrite the file?", vbYesNo + vbQuestion + vbDefaultButton2, "File Exist")

                        If iResponse = vbYes Then

                        ' Checks to see if the file is open

                            If FileLocked(FileSave) Then

                               MsgBox "'" + FileSave + "' is open by you or another user.  Please close the file and re-run the macro.", vbOKOnly + vbExclamation, "File Is Open"

                               errorfinish = True

                               GoTo Finish

                            End If

                        Else

                            errorfinish = True

                            GoTo Finish

                        End If

                    End If

                  • Re: Save as PDF but check for open document first
                    Dallas Havens

                    I added the above code to my macro but I got a compile error on the "If FileLocked" line. Says Sub or Function not defined. I copied the macro below.

                     

                    Also I don't need to check file location or if file name exist, just if it is open. instead of a measage box I would like a selection box with ok and cancel where ok rechecks for the open file and the cancel exits the macro. If the file is not open then it should continue to save or replace the existing PDF.

                     

                    Dim swApp        As SldWorks.SldWorks
                    Dim swModel      As SldWorks.ModelDoc2
                    Dim swDraw       As SldWorks.DrawingDoc
                    Dim Filepath     As String
                    Dim FileName     As String
                    Dim boolstatus As Boolean
                    Dim longstatus As Long, longwarnings As Long

                    Sub main()

                    Set swApp = Application.SldWorks
                    Set swModel = swApp.ActiveDoc

                    ' Is document active?

                    If swModel Is Nothing Then

                        swApp.SendMsgToUser2 "A document must be active.", swMbWarning, swMbOk

                        Exit Sub

                    End If

                    'Save Document

                    swModel.Save

                    ' Is it a Drawing document?

                    If swModel.GetType <> swDocDRAWING Then

                        Exit Sub
                       
                    End If

                    Set swDraw = swModel

                    Filepath = Left(swDraw.GetPathName, InStrRev(swDraw.GetPathName, "\"))

                    FileName = Left(swDraw.GetTitle, Len(swDraw.GetTitle) - 9)

                    swDraw.SaveAs (Filepath + FileName + ".PDF")
                        iResponse = MsgBox("The PDF will be saved to..." + Chr(13) + FileSave + Chr(13) + Chr(13) + "Is this correct?", vbYesNo + vbQuestion, "PDF will be saved to...")
                        If iResponse = vbNo Then
                            errorfinish = True
                            GoTo Finish
                        Else
                        End If
                        ' Checks if PDF file already exist in the directory
                        Set fso = CreateObject("Scripting.FileSystemObject")
                        If fso.FileExists(FileSave) = True Then
                            iResponse = MsgBox("A PDF for '" & FileName & "' already exist, are you sure you want to overwrite the file?", vbYesNo + vbQuestion + vbDefaultButton2, "File Exist")
                            If iResponse = vbYes Then
                            ' Checks to see if the file is open
                                If FileLocked(FileSave) Then
                                    MsgBox "'" + FileSave + "' is open by you or another user.  Please close the file and re-run the macro.", vbOKOnly + vbExclamation, "File Is Open"
                                    errorfinish = True
                                    GoTo Finish
                                End If
                            Else
                                errorfinish = True
                                GoTo Finish
                            End If
                        End If

                    End Sub