Office: Access VBA – Prüfen, ob eine PDF bereits geöffnet ist, bevor sie erneut geöffnet wird

Beschreibung:

Ich arbeite mit Access VBA und habe eine Funktion implementiert, die beim Klick auf einen Button („Unterzeichnet“) einen Bericht als PDF exportiert.

Was aktuell funktioniert:

• Beim Klick auf „Unterzeichnet“ wird die PDF erfolgreich erstellt ✅
• Die PDF wird direkt geöffnet ✅
• Die relevanten Informationen (Wer, Wann) werden im Unterformular „Dokument“ gespeichert und angezeigt ✅
• Ãœber einen „Öffnen“-Button kann die erzeugte PDF erneut geöffnet werden ✅

Mein Problem:
Wenn ich mehrfach auf den „Öffnen“-Button klicke, wird die PDF jedes Mal erneut geöffnet.

Ich möchte stattdessen prüfen:
Ob die Datei bereits geöffnet ist
Falls ja, soll eine Meldung erscheinen wie:
„Das Dokument ist bereits geöffnet“

Was ich suche:
Eine Möglichkeit in VBA zu erkennen, ob eine bestimmte PDF-Datei bereits geöffnet ist (z. B. im Standard-PDF-Viewer), bevor ich sie erneut öffne.

Frage:
Wie kann ich in Access VBA überprüfen, ob eine PDF-Datei bereits geöffnet ist, um ein mehrfaches Öffnen zu verhindern?

Mein Code:
Private Sub Oeffnen_Click()
On Error GoTo Fehler

Dim pfad As String
pfad = Nz(Me!pfad, "")

If pfad = "" Then
MsgBox "Kein PDF-Pfad gespeichert.", vbExclamation
Exit Sub
End If
If Dir(pfad) = "" Then
MsgBox "Die PDF-Datei wurde nicht gefunden.", vbExclamation
Exit Sub
End If

Dim dateiname As String
dateiname = Mid(pfad, InStrRev(pfad, "\") + 1)

Dim tempDir As String
tempDir = Environ("TEMP") & "\AccessPDF\"

If Dir(tempDir, vbDirectory) = "" Then MkDir tempDir

Dim tempPfad As String
tempPfad = tempDir & dateiname

' Prüfen, ob Temp-Datei existiert
If Dir(tempPfad) <> "" Then

' Versuch: Temp-Datei löschen
On Error Resume Next
Kill tempPfad
If Err.Number <> 0 Then
' Datei konnte NICHT gelöscht werden ? PDF ist offen
MsgBox "Das Dokument ist bereits geöffnet.", vbInformation
Exit Sub
End If
On Error GoTo Fehler
End If

' Temp-Datei neu erzeugen
FileCopy pfad, tempPfad

' PDF öffnen
Shell "cmd /c start """" """ & tempPfad & """", vbHide
Exit Sub

Fehler:
MsgBox "Fehler: " & Err.Description, vbExclamation
End Sub

 

Daniel Pineault hat mal was damit gemacht:

Code:

Option Compare Database
Option Explicit

Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hWnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long

Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As LongPtr, _
                                                         ByVal wCmd As Long) As Long

Public Function IsPDF_Open(sfile As String) As Boolean
' Procedure : IsPDF_Open
' Derived from    : Daniel Pineault, CARDA Consultants Inc.
' Website           : http://www.cardaconsultants.com
 
  Dim hWndParent As LongPtr
  Dim hwndChild As LongPtr
  Dim sFileName As String

  IsPDF_Open = False
 
  sFileName = Right$(sfile, Len(sfile) - InStrRev(sfile, "\"))    'Get just the filename from the full path/filename/ext
  hWndParent = FindChildWindow(FnFindWindowLike("*" & sFileName & "*Adobe*"), "AVL_AVView", "AVDocumentMainView", True)
 
  If Not hWndParent = 0 Then IsPDF_Open IsPDF_Open = True
    'This means that we can't find an instance of Adobe with the specified File, so we could use the traditional approach for the first time

End Function

'Purpose     :  Enumerates all the child windows and returns the handle of a child window with
'               a matching caption or class name.
'Inputs      :  lParentHwnd             The handle to a parent window
'               [sClassName]            The class name to search for.
'               [sCaption]              The caption to search for.
'               [bSearchChildWindows]   Searchs within each child window for a matching window
'Outputs     :  Returns the handle of child window or zero if not found
'Source      :  https://visualbasic.happycodings.com/forms/code54.html
Private Function FindChildWindow(ByVal lParentHwnd As LongPtr, Optional ByVal sClassName As String, Optional ByVal sCaption As String, Optional bSearchChildWindows As Boolean = False) As LongPtr
  Dim lWinHwnd As LongPtr
 
  Const clMaxName As Long = 255
  Const GW_CHILD = 5
  Const GW_HWNDNEXT = 2
  Const GW_HWNDFIRST = 0
 
  Dim sTestName As String * clMaxName, lNumChars As Long
  Dim bClassMatches As Boolean, bCaptionMatches As Boolean

  'Ignore case
  sClassName = UCase$(sClassName)
  sCaption = UCase$(sCaption)

  'Find the first child window
  lWinHwnd = GetWindow(lParentHwnd, GW_CHILD)
  If lWinHwnd = 0 Then
    Exit Function
  End If
  Do
    bClassMatches = False
    bCaptionMatches = False
    lNumChars = clMaxName

    If Len(sClassName) Then
      'Get the child window classname
      lNumChars = GetClassName(lWinHwnd, sTestName, (clMaxName))
      If UCase$(Left$(sTestName, lNumChars)) = sClassName Then
        'Found matching class name
        bClassMatches = True
      End If
    Else
      'No class name specified
      bClassMatches = True
    End If

    If Len(sCaption) Then
      lNumChars = GetWindowText(lWinHwnd, sTestName, (clMaxName))
      If UCase$(Left$(sTestName, lNumChars)) = sCaption Then
        'Found matching caption
        bCaptionMatches = True
      End If
    Else
      'No caption specified
      bCaptionMatches = True
    End If

    If bClassMatches And bCaptionMatches Then
      'Found matching dialog, return handle
      FindChildWindow = lWinHwnd
      Exit Do
    ElseIf bSearchChildWindows Then
      'Search Child windows
      FindChildWindow = FindChildWindow(lWinHwnd, sClassName, sCaption, True)
      If FindChildWindow Then
        Exit Do
      End If
    End If

    'Try next next child
    lWinHwnd = GetWindow(lWinHwnd, GW_HWNDNEXT)
    If lWinHwnd = 0 Then
      'No more child windows
      Exit Do
    End If
  Loop While lWinHwnd     'Loop until there are no more child windows
End Function

ungetestet.......

Gruß
Bernd

 

ansonsten:

Um in VBA zu prüfen, ob eine PDF-Datei geöffnet ist, versucht man am besten, die Datei exklusiv im Lese- oder Schreibmodus zu öffnen (z.B. mit
Open oder CreateObject("Scripting.FileSystemObject")). Schlägt dies fehl, ist die Datei geöffnet.
Ansatz 1: Prüfung durch Öffnen (Error Handling)
Dieser Code versucht die Datei zu öffnen. Ist sie bereits geöffnet, wird ein Fehler generiert.

Code:

Function IsFileOpen(filename As String) As Boolean
   Dim fileNum As Integer, errNum As Integer
 
   On Error Resume Next
   fileNum = FreeFile()
   Open filename For Input Lock Read As #fileNum
   Close fileNum
   errNum = Err.Number
   On Error GoTo 0
 
   ' Wenn Fehler 70 auftritt, ist die Datei geöffnet (Zugriff verweigert)
   If errNum = 70 Then
       IsFileOpen = True
   Else
       IsFileOpen = False
   End If
End Function

Sub TestPDFOpen()
   Dim pdfPath As String
   pdfPath = "C:\Pfad\zu\deiner\datei.pdf"
 
   If IsFileOpen(pdfPath) Then
       MsgBox "Die PDF-Datei ist bereits geöffnet.", vbExclamation
   Else
       MsgBox "Die PDF-Datei ist geschlossen.", vbInformation
   End If
End Sub

Wichtige Hinweise:

• Dieser Ansatz prüft, ob die Datei in irgendeinem Programm (Adobe Reader, Browser, etc.) geöffnet ist, da das System eine geöffnete Datei sperrt.
• Alternativ kann die Existenz des Adobe-Prozesses via Task-Manager geprüft werden, was jedoch ungenauer ist.

 

Es gibt keine zuverlässige Methode, um zu prüfen, ob eine PDF-Datei bereits geöffnet ist. PDF-Viewer arbeiten i.d.R. mit einer Kopie. Damit scheitert eine Prüfung mit "exklusiven Open" und die andere Variante scheitert schon an der Vielzahl der verschiedenen Programme, womit PDF-Dateien geöffnet werden können. Da kann man nicht alle möglichen Captions und Windows-Classnamen abfragen bzw. im Programm integrieren.

Man kann in Windows zwar erkennen, ob eine Datei geöffnet wird, aber nicht, ob sie bereits als Kopie geöffnet ist, wenn kein Lock auf die Datei vom öffnenden Programm gesetzt wird.

Knobbi38

 

Man könnte prüfen, ob eine Instanz/Fenster des PDF-Viewers geöffnet ist, der genutzt wird.Das setzt allerdings voraus, dass immer derselbe Viewer genutzt wird und man nicht parallel mit mehreren PDFs arbeitet.

 

Ist aber auch keine zuverlässige Methode, weil u.U. die PDF Datei durchaus auch in einem Browser geöffnet sein könnte.

Alternative:
anstatt die PDF direkt zu öffnen, könnte man die PDF Datei mit dem Standardprogramm öffnen und dabei die PID zwischenspeichern. Anhand dieser PID kann man dann prüfen, ob diese noch existiert oder nicht. Nicht hundertprozentig aber immerhin könnte man viele doppelte Öffnungen damit vorab unterbinden.

Knobbi38