VBA Code to close an opened pdf amendment needed

[kelly mort]

Hello everyone.
I found this code on stack overflow:

Check if a certain pdf file is open and close it

I use this code to export a pdf file from a word document. Before exporting I need to check first if a file with the same name is already open, and if so close it then export. I tried many things...

stackoverflow.com

I want to be able to detect the specific app in which the pdf file is opened.

On this line:

    Hwnd = FindWindow(vbNullString, "Current Letter Preview.pdf - Adobe Reader")

Option Explicit

Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" _
(ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, _
lParam As Any) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassname As String, ByVal lpWindowName As String) As Long

Private Const WM_CLOSE = &H10

Sub Sample()
    Dim Hwnd As Long

    '~~> Find the window of the pdf file
    Hwnd = FindWindow(vbNullString, "Current Letter Preview.pdf - Adobe Reader")

    If Hwnd Then
        '~~> Close the file
        PostMessage Hwnd, WM_CLOSE, 0, ByVal 0&
    Else
        MsgBox "Pdf File not found"
    End If
End Sub

How do I go about that?

Thanks in advance.

 

[Jaafar Tribak]

Hi Kelly,
As you said, the code closes the entire app (pdf reader), not individual tabs. I am not familiar with pdf files and I don't have a pdf editor installed so I can test code. Hopefully someone with more experience can help you.

 

[mugginsjr]

See if this works for you :

In a Standard Module:

Option Explicit

#If Win64 Then
    Private Const NULL_PTR = 0^
#Else
    Private Const NULL_PTR = 0&
#End If

#If VBA7 Then
    Private Declare PtrSafe Function GetDesktopWindow Lib "user32" () As LongPtr
    Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As LongPtr
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
#Else
    Private Enum LongPtr
        [_]
    End Enum
    Private Declare Function GetDesktopWindow Lib "user32" () As LongPtr
    Private Declare Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As LongPtr
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr
#End If


Function CloseWindowByPartialCaption(ByVal PartialCaption As String) As Boolean

    Const SC_CLOSE = &HF060&, WM_SYSCOMMAND = &H112
    Dim hwnd As LongPtr, sFullCaption As String
  
    sFullCaption = FindWindowLike(GetDesktopWindow(), PartialCaption)
    If Len(sFullCaption) Then
        hwnd = FindWindow(vbNullString, sFullCaption)
        Call SendMessage(hwnd, WM_SYSCOMMAND, SC_CLOSE, ByVal 0&)
        CloseWindowByPartialCaption = True
    End If
  
End Function

Private Function FindWindowLike(hWndParent As LongPtr, Caption As String) As String

    Const GW_HWNDNEXT = 2&, GW_CHILD = 5&
    Dim hwnd As LongPtr
  
    hwnd = GetWindow(hWndParent, GW_CHILD)
    Do Until hwnd = NULL_PTR
        If WindowText(hwnd) Like "*" & Caption & "*" Then
            FindWindowLike = WindowText(hwnd)
            Exit Do
        End If
        hwnd = GetWindow(hwnd, GW_HWNDNEXT)
    Loop
  
End Function

Private Function WindowText(hwnd As LongPtr) As String

  Const WM_GETTEXT = &HD, WM_GETTEXTLENGTH = &HE
  Dim lRet As LongPtr, str As String
  
    If hwnd <> NULL_PTR Then
        lRet = SendMessage(hwnd, WM_GETTEXTLENGTH, NULL_PTR, ByVal 0&) + 1&
        If lRet > NULL_PTR Then
            str = String$(CLng(lRet), vbNullChar)
            lRet = SendMessage(hwnd, WM_GETTEXT, lRet, ByVal str)
            If lRet > NULL_PTR Then WindowText = Left$(str, CLng(lRet))
        End If
    End If
  
End Function

Code Usage example:

Sub Test()
    If CloseWindowByPartialCaption(PartialCaption:="Current Letter Preview") Then
        MsgBox "Window successfully colsed."
    Else
        MsgBox "Unable to find and\or close window."
    End If
End Sub

Works awesome! The only problem I'm having is that I am opening several pdf files in separate tabs of the Acrobat Reader. ie., if I have 5 files open then there are 5 tabs open. My VBA script iterates through a hundred or so