Open PDF Object as Read Only

Jeffrey Mahoney

Well-known Member
Joined
May 31, 2015
Messages
2,776
Office Version
  1. 365
Platform
  1. Windows
I use the code below to embed a PDF file as an object into my workbook. It works fine unless I have the same file open in Adobe Reader. The macro tells me that.

What I need is to open the file as read only so I don't have to always close it in Adobe Reader. Any suggestions?


VBA Code:
Sub AddQuote()

  Dim FileToOpen As String
  Dim asht As Worksheet
  Dim osht As Worksheet
  Dim Cel As Range
  Dim qCel As Range
  Dim oCel As Range
  Dim oPDF As Variant
  Dim oPDFName As String
  Dim cLeft As Double
  Dim cTop As Double
  Dim MaxONum As Long
  Dim MaxOFormat As String
  Dim FltrDesc As String
  Dim FltrExt As String
  
  Set asht = ActiveSheet
  
  Set qCel = Selection.Resize(1, 1)
  On Error GoTo HellFire
  Set qCel = Intersect(asht.Range("Quote_hdr").EntireColumn, qCel.EntireRow)
  On Error GoTo 0
  
  Set osht = Sheets("Objects")
  Set oCel = osht.Cells(osht.Cells.Rows.Count, 2).End(xlUp).Offset(5, 0)
  cLeft = oCel.Offset(0, 1).Left
  cTop = oCel.Offset(0, 1).Top

  FileToOpen = SelectPDFOpen(False, "Choose a PDF Quote File")
  If FileToOpen = "" Then Exit Sub
  
  EventsOff
  
  With osht
    On Error Resume Next
    
    Set oPDF = .OLEObjects.Add(filename:=FileToOpen, Link:=False, DisplayAsIcon:=True, IconFileName:= _
      "C:\WINDOWS\Installer\{AC76BA86-1033-FFFF-7760-000000000006}\_PDFFile.ico", _
          IconIndex:=0, IconLabel:="Adobe Acrobat Document", Left:=cLeft, Top:=cTop, Height:=50, Width:=50)
        
    On Error GoTo 0
    
    If IsFileOpen(FileToOpen) = True Then
      MsgBox "That file is opened in another application. please close it and try again"
      EventsOn
      Exit Sub
    End If
    
    If oPDF Is Nothing Then
      EventsOn
      Exit Sub
    End If
    
    MaxONum = Application.Max(osht.Range("A:A")) + 1
    MaxOFormat = Format(MaxONum, "000")
    oPDFName = "Quote " & MaxOFormat
    oPDF.Name = oPDFName
    '.Shapes(oPDFName).LockAspectRatio = msoFalse
'    .Shapes(oPDFName).Left = cLeft
'    .Shapes(oPDFName).Top = cTop
'    .Shapes(oPDFName).Height = 30
'    .Shapes(oPDFName).Width = 200
    oCel.Value = oPDFName
    oCel.Offset(0, -1).Value = MaxONum
  End With
  qCel.Value = oPDFName
  
  
HellFire:
  EventsOn
End Sub



Function SelectPDFOpen(MS As Boolean, Titl As String) As String

    Dim fd As FileDialog, selectedFile As String
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .AllowMultiSelect = MS
        .Title = Titl                             '"Select PDF file to insert"
        .Filters.Clear
        .Filters.Add "PDF Documents", "*.pdf"
        If Not .Show Then
            'MsgBox "User cancelled"
            Exit Function
        End If
        SelectPDFOpen = .SelectedItems(1)
    End With
    

End Function


Function IsFileOpen(filename As String) As Boolean
    Dim filenum As Integer
    Dim errnum As Integer
    
    On Error Resume Next   ' Turn error checking off.
    filenum = FreeFile()   ' Get a free file number.
    ' Attempt to open the file and lock it.
    Open filename For Input Lock Read As #filenum
    Close filenum          ' Close the file.
    errnum = Err           ' Save the error number that occurred.
    On Error GoTo 0        ' Turn error checking back on.
    ' Check to see which error occurred.
    Select Case errnum
        ' No error occurred.
        ' File is NOT already open by another user.
        Case 0
         IsFileOpen = False
        ' Error number for "Permission Denied."
        ' File is already opened by another user.
        Case 70
            IsFileOpen = True
        ' Another error occurred.
        Case Else
            Error errnum
    End Select
End Function
 

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
You could try to set the PDFs' file attribute to Read Only before adding the file as an OLE object (and clearing it afterwards ...)
 
Upvote 0
I could try that. I suspect that Adobe Reader might set the attribute as File Open. Somebody had suggested that I change the Enhanced Security setting "Enable Protected Mode at Startup" in Adobe to false. That didn't work.
 
Upvote 0
I could try that. I suspect that Adobe Reader might set the attribute as File Open.
At the moment AR-DC opens the file, it opens the file "for exclusive" telling the OS that others should stay away until the file is closed again. This is common behavior and it is different from the file attribute on disk. Open any workbook, then open windows explorer and try to move the workbook. This fails. Close the workbook, set the read-only attribute and the workbook can be moved after opening. This trick should also work with a PDF.
 
Upvote 0

Forum statistics

Threads
1,214,819
Messages
6,121,746
Members
449,050
Latest member
excelknuckles

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top