VBA to Close a PDF Document from Excel

Question

I have this lovely little procedure that is supposed to either shut down the window with the Acrobat display or just one document in it. Only the design is of my own making, meaning I don't fully understand the code, but I do know that it works only partially. It will quit Adobe Acrobat in full, regardless of how many documents are displayed but it can't close just one (as the original from which it was transcribed claimed that it could and should).

Private Sub CloseReaderDC(Optional ByVal MailIdx As Integer)

    Dim WinId       As String
    Dim Wnd         As LongPtr
    
    If MailIdx Then
        WinId = AcrobatWindowID(Mail(MailIdx))
        Wnd = FindWindow(vbNullString, WinId)
        PostMessage Wnd, WM_CLOSE, 0, ByVal 0&
    Else
        WinId = AcrobatWindowID
        Wnd = FindWindow(WinId, vbNullString)
        SendMessage Wnd, WM_CLOSE, 0, ByVal 0&
    End If
End Sub

The logic is that the parameter MailIdx identifies a file name which is sufficient to find a top window. If no value is given the app should be shut down. This part works. The other part also works, but only if there is a single document open, in which case not the document is closed but the entire application. I believe this shutdown may be caused by Acrobat Reader itself which doesn't see a reason for staying open with no document to display. I also think that the window handle may not be found if there are several documents because FindWindow finds a top window only and the one I want to close would be the second one. In practice, I tried both, to close the existing before opening another one and after. In the one case the app gets shut down, in the other nothing happens.

I don't know why my tutor uses SendMessage in one case and PostMessage in the other. I also don't know if the window I'm after is a Child Window or how to get a handle on it if it is. Any suggestions?

Edit 11 Jan 2021

I used the following code to test @FaneDuru's solution.

Private Sub Test_CloseReaderDC()

    ReDim Mail(2)
    Mail(0) = ""
    Mail(1) = "File1.PDF"
    Mail(2) = "File2.PDF"

    CloseReaderDC 1
End Sub
Private Sub CloseReaderDC(Optional ByVal MailIdx As Integer)
    ' NIC 003 ++ 10 Jan 2021

    Dim WinTitle    As String
    Dim WinCap      As String
    Dim Wnd         As LongPtr
    
    WinTitle = AcrobatWindowID
    If MailIdx Then
        WinCap = AcrobatWindowID(Mail(MailIdx))
        Wnd = FindWindow(vbNullString, WinCap)
        Debug.Print Wnd
        SendMessage Wnd, WM_CloseClick, 6038, ByVal 0&
    Else
        Wnd = FindWindow(WinTitle, vbNullString)
        Debug.Print Wnd
        SendMessage Wnd, WM_CLOSE, 0, ByVal 0&
    End If
End Sub

Function AcrobatWindowID(Optional ByVal Wn As String)
    ' NIC 003 ++ 07 Jan 2021

    Dim Fun     As Boolean
    
    Fun = CBool(Len(Wn))
    If Fun Then Wn = Wn & " - "
    AcrobatWindowID = Wn & Split("AcrobatSDIWindow,Adobe Acrobat Reader DC", ",")(Abs(Fun))
End Function

The code worked perfectly for both 1 or 2 files, not closing the app until called with a parameter of 0. But on second try it failed to find the window and therefore took no action.

I started Acrobat and selected the 2 previously opened files from its File>Open menu. File1 was in the first tab, File2 in the second, active. Then I attempted to delete File1 which failed. Then I called the code with 2 as parameter which closed the top file. Thereafter the code found the window for File1 and closed it.

I don't think the apparent rule is followed consistently, however. How the files were opened seems to make a difference. In my project the files are opened by hyperlink, one at a time. My above test therefore is not indicative of how FaneDuru's suggestion will work in my project but it proves that the solution works.

Answer 1

You did not say anything about my comment regarding closing the active document by programmatically pressing the File menu "Close File" control...

This way of closing does not make Acrobat application quitting. It stay open, even if only a document was open in the moment of running the code.

So, test the next code line, please. You need the Acrobat Reader DC handler and the necessary arguments, like following:

Const WM_CloseClick = &H111
SendMessage Wnd, WM_CloseClick, 6038, ByVal 0&

6038 is the 'Close File' File menu control ID. I could determine it using the next function:

Private Function findControlID(mainWHwnd As LongPtr, ctlNo As Long) As Long
   Dim aMenu As LongPtr, sMenu As LongPtr
   
   aMenu = GetMenu(mainWHwnd): Debug.Print "Main menu = " & Hex(aMenu)
    sMenu = GetSubMenu(aMenu, 0&): Debug.Print "File menu = " & Hex(sMenu)
    mCount = GetMenuItemCount(sMenu): Debug.Print "File menu no of controls: " & mCount 'check if it is 28
     findControlID = GetMenuItemID(sMenu, ctlNo - 1) 'Menu controls are counted starting from 0
End Function

The above function was called in this way:

Sub testFindCloseControlID()
  Dim Wnd As LongPtr
   'Wnd = findWindowByPartialTitle("Adobe Acrobat Reader DC") 'you will obtain it in your way
   Debug.Print findControlID(Wnd, 15) '15 means the fiftheenth control of the File menu (0)
End Sub

15 has been obtained counting the horizontal controls separators, too.

In order to find "Adobe Acrobat Reader DC" window handler I used the function mentioned above, but this does not matter too much. You may use your way of determining it...

Please, test the above way and send some comments

Edited:

In order to extract the applications menu(s) captions, I use the next declarations:

Option Explicit

'APIs for identify a window handler
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
             (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hwnd As LongPtr) As Long
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 GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As Long
'____________________________________________________

'Menu related APIs
Private Declare PtrSafe Function GetMenu Lib "user32.dll" (ByVal hwnd As LongPtr) As LongPtr
Private Declare PtrSafe Function GetSubMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal nPos As Long) As LongPtr
Private Declare PtrSafe Function GetMenuItemID Lib "user32" _
                                   (ByVal hMenu As LongPtr, ByVal nPos As Long) As Long
Private Declare PtrSafe Function GetMenuItemCount Lib "user32" (ByVal hMenu As LongPtr) As Long
        Private Declare PtrSafe Function GetMenuItemInfo Lib "user32" Alias "GetMenuItemInfoA" (ByVal hMenu As LongPtr, _
                                        ByVal Un As Long, ByVal b As Long, lpMenuItemInfo As MENUITEMINFO) As Long

Private Declare PtrSafe Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As LongPtr, _
                ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
'_____________________________________________________


Private Type MENUITEMINFO
    cbSize As Long
    fMask As Long
    fType As Long
    fState As Long
    wID As Long
    hSubMenu As LongPtr
    hbmpChecked As LongPtr
    hbmpUnchecked As LongPtr
    dwItemData As LongPtr
    dwTypeData As String
    cch As Long
    hbmpItem As LongPtr
End Type

Private Const GW_HWNDNEXT = 2

And the next functions/subs:

To find any window knowing only its partial title:

Sub testFindWindByPartTitle()
  Debug.Print findWindowByPartialTitle("Notepad")
End Sub

Private Function findWindowByPartialTitle(ByVal sCaption As String, Optional strSecond As String) As LongPtr
  Dim lhWndP As LongPtr
    Dim sStr As String
    findWindowByPartialTitle = CLngPtr(0)
    lhWndP = FindWindow(vbNullString, vbNullString) 'PARENT WINDOW
    Do While lhWndP <> 0
        sStr = String(GetWindowTextLength(lhWndP) + 1, Chr$(0))
        GetWindowText lhWndP, sStr, Len(sStr)
        If Len(sStr) > 0 Then sStr = left$(sStr, Len(sStr) - 1)
        If InStr(1, sStr, sCaption) > 0 And _
                IIf(strSecond <> "", InStr(1, sStr, strSecond) > 0, 1 = 1) Then
            findWindowByPartialTitle = lhWndP
            Exit Do
        End If
        lhWndP = GetWindow(lhWndP, GW_HWNDNEXT)
    Loop
End Function

A version of extract the necessary ID by control caption, but it works only for Notepad:

Private Sub TestfindMenuItemsByCaption()
  Const NotePApp As String = "Notepad"
  Debug.Print findMenuIDByString(NotePApp, "Save") 'it does work
  Const pdfApp As String = "Adobe Acrobat Reader DC"
  Debug.Print findMenuIDByString(pdfApp, "Close")  'it does not work
End Sub
Private Function findMenuIDByString(pdfApp As String, searchString As String) As Long
    Dim mainWHwnd As LongPtr, aMenu As LongPtr, mCount As Long
    Dim LookFor As Long, sMenu As LongPtr, sCount As Long
    Dim LookSub As Long, sID As Long, sString As String
    
    mainWHwnd = findWindowByPartialTitle(pdfApp)
    aMenu = GetMenu(mainWHwnd): Debug.Print "Main menu = " & Hex(aMenu)
    sMenu = GetSubMenu(aMenu, 0): Debug.Print "File menu = " & Hex(sMenu)
    sCount& = GetMenuItemCount(sMenu)
    For LookSub& = 0 To sCount& - 1
        sID& = GetMenuItemID(sMenu, LookSub&): Debug.Print "ID = " & sID: 'Stop
        sString$ = String$(100, " ")
        Call GetMenuString(sMenu, sID&, sString$, 100&, 1&) ' 1&)
        Debug.Print sString$ ': Stop
        If InStr(LCase(sString$), LCase(searchString$)) Then
            findMenuIDByString = sID
            Exit Function
        End If
    Next LookSub&
End Function

And a second version, unfortunately working exactly in the same way. I mean, returning the ID only for Notepad:

Private Sub TestfindMenuItemsByCaptionBis()
  Const NotePApp As String = "Notepad"
  Debug.Print findMenuItemIDByCaption(NotePApp, "Save")
  Const pdfApp As String = "Adobe Acrobat Reader DC"
  Debug.Print findMenuItemIDByCaption(pdfApp, "Close")
End Sub
Private Function findMenuItemIDByCaption(strApp As String, strCaption As String)
  Dim appHwnd As LongPtr, hMenu As LongPtr, fMenu As LongPtr, i As Long
  Dim retval As Long, mii As MENUITEMINFO 'mii receives information about each item
  Const WM_SaveClick = &H111, MIIM_STATE = &H1, MIIM_STRING = &H40&, MIIM_ID = &H2&, MIIM_CHECKMARKS = &H8&
  Const MIIM_SUBMENU = &H4&, MIIM_TYPE = &H10, MIIM_FTYPE = &H100&, MIIM_DATA = &H20&
  
    appHwnd = findWindowByPartialTitle(strApp)
     If appHwnd = 0 Then MsgBox "No application window found...": Exit Function

       hMenu = GetMenu(appHwnd)         'application window Menu
       fMenu = GetSubMenu(hMenu, 0)     'app window 'File' Submenu

       For i = 0 To GetMenuItemCount(fMenu)
         With mii
            .cbSize = Len(mii)
            .fMask = MIIM_STATE Or MIIM_SUBMENU Or MIIM_TYPE
            .dwTypeData = space(256)
            .cch = 256
                retval = GetMenuItemInfo(fMenu, i, 1, mii) '2 = the third menu item
                Debug.Print left(.dwTypeData, .cch)
                If InStr(left(.dwTypeData, .cch), strCaption) > 0 Then
                   findMenuItemIDByCaption = GetMenuItemID(fMenu, i): Exit Function
                End If
        End With
     Next i
End Function

I tried all constants as I could find, but not success... If we would find a way, a subroutine could also read the recent files list and activate the needed one, if is not the active one is the necessary one.