Macro PDF failed when PDF file is already open.

[Anonymous]

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

[Mario-Villada]

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

[Anonymous]

How to recover the "Filename.pdf" because "oDocument.DisplayName" and "Filename" are defined after.

[Mario-Villada]

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