Community
Hi,
I created a macro for generate a PDF drawing, but when one file has been already created, AND he's already open, the macro don't work.
How to stop the macro automatically and notify that the macro has been stopped because the file is open.
Below, the current macro :
Sub PublishPDF() 'Get the PDF translator Add-In. Dim PDFAddin As TranslatorAddIn Set PDFAddin = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}") 'Set a reference to the active document (the document to be published). Dim oDocument As Document Set oDocument = ThisApplication.ActiveDocument Dim oContext As TranslationContext Set oContext = ThisApplication.TransientObjects.CreateTranslationContext oContext.Type = kFileBrowseIOMechanism 'Create a NameValueMap object. Dim oOptions As NameValueMap Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap 'Create a DataMedium object. Dim oDataMedium As DataMedium Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium 'Check whether the translator has 'SaveCopyAs' options. If PDFAddin.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions) Then If TypeOf oDocument Is DrawingDocument Then oOptions.Value("All_Color_AS_Black") = 1 oOptions.Value("Sheet_Range") = kPrintAllSheets oOptions.Value("Remove_Line_Weights") = 0 oOptions.Value("Remove_Line_Weights") = 0 oOptions.Value("Vector_Resolution") = 400 End If End If 'Set filename as original document filename. Dim FileName As String FileName = Left(oDocument.DisplayName, Len(oDocument.DisplayName) - 4) 'Set the destination to save files. oDataMedium.FileName = "C:\...\" & FileName & ".pdf" 'Publish document. Call PDFAddin.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium) End Sub
You could first check if the PDF you want to create already exists.
If System.IO.File.Exists("C:\myfile.pdf") Then MsgBox("PDF Exists") Else MsgBox("PDF Does not exist") End If
I am not sure if this is what you want but try this code.It checks first if the PDF already exist. if it does then shows a message, itherwise it creates your PDF.
Private Function File_Exists(ByVal sPathName As String, Optional Directory As Boolean) As Boolean 'Code from internet: http://vbadud.blogspot.com/2007/04/vba-function-to-check-file-existence.html 'Returns True if the passed sPathName exist 'Otherwise returns False On Error Resume Next If sPathName <> "" Then If IsMissing(Directory) Or Directory = False Then File_Exists = (Dir$(sPathName) <> "") Else File_Exists = (Dir$(sPathName, vbDirectory) <> "") End If End If End Function Sub PublishPDF() 'Get the PDF translator Add-In. Dim PDFAddin As TranslatorAddIn Set PDFAddin = ThisApplication.ApplicationAddIns.ItemById("{0AC6FD96-2F4D-42CE-8BE0-8AEA580399E4}") 'Set a reference to the active document (the document to be published). Dim oDocument As Document Set oDocument = ThisApplication.ActiveDocument Dim oContext As TranslationContext Set oContext = ThisApplication.TransientObjects.CreateTranslationContext oContext.Type = kFileBrowseIOMechanism 'Create a NameValueMap object. Dim oOptions As NameValueMap Set oOptions = ThisApplication.TransientObjects.CreateNameValueMap 'Create a DataMedium object. Dim oDataMedium As DataMedium Set oDataMedium = ThisApplication.TransientObjects.CreateDataMedium 'Check whether the translator has 'SaveCopyAs' options. If PDFAddin.HasSaveCopyAsOptions(oDataMedium, oContext, oOptions) Then If TypeOf oDocument Is DrawingDocument Then oOptions.Value("All_Color_AS_Black") = 1 oOptions.Value("Sheet_Range") = kPrintAllSheets oOptions.Value("Remove_Line_Weights") = 0 oOptions.Value("Remove_Line_Weights") = 0 oOptions.Value("Vector_Resolution") = 400 End If End If 'Set filename as original document filename. Dim FileName As String 'FileName = Left(oDocument.DisplayName, Len(oDocument.DisplayName) - 4) FileName = oDocument.DisplayName 'Set the destination to save files. oDataMedium.FileName = "C:\...\" & FileName & ".pdf" If File_Exists("C:\...\" & FileName & ".pdf") Then MsgBox ("PDF Already exists") Else: 'Publish document. Call PDFAddin.SaveCopyAs(oDocument, oContext, oOptions, oDataMedium) End If End Sub