VBA to check if user has pdf file open

**Rerock** · 10-08-2014, 04:00 PM

Hi,
The following code works great as long as you have entered a manual file path.

Sub Test1()
    Const strPDFpath As String = "P:\Project XLSM\NEW PROJECTS\_TEST_EXAMPLES\TEST_Check if PDF is Open and Close\Signed Agreement.pdf"
    Dim wbk As Workbook, ws As Worksheet
    If IsFileOpen(strPDFpath) = True Then
    MsgBox "File is open!"
    Else
    MsgBox "File is not open!"
    End If
End Sub
Function IsFileOpen(FileName As String)
    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
    On Error GoTo 0
    Select Case ErrNum
    Case 0
    IsFileOpen = False
    Case 70
    IsFileOpen = True
    Case Else
    Error ErrNum
    End Select
End Function

How can this be amended to work with "ThisWorkbook.Path", "ActiveWorkbook.Path", "Range("YOUR_NAMED_RANGE").Value", or some other type of variable?

**Leith Ross** · 10-08-2014, 06:27 PM

Hello Rerock,

This macro will search all open PDF documents. If the given document is found then it is closed.

The document name matching is not case sensitive. You may use either the full document name or part of the name to match an open document.

Copy this code into a VBA Module in your workbook.

Macor Code to Close an Opened PDF File

' Written:  October 08, 2014
' Author:   Leith Ross
' Summary:  Searches all open PDF documents. If a document is found that matches the
'           given file name either fully or partially, it will be closed. If the given
'           file name is not found to be open then a dialog message alerts the user.


' 32 Bit Windows API calls.
Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
         
Private Declare Function GetWindowText Lib "user32.dll" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal aint As Long) As Long
          
Private Declare Function GetWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal wCmd As Long) As Long

Private Declare Function GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hWnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
        
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Sub ClosePDF(ByVal FileName As String)

    Dim Found   As Boolean
    Dim hWnd    As Long
    Dim Pid     As Long
    Dim RefCell As Range
    Dim ret     As Long
    Dim Title   As String
    Dim Tid     As Long
    Dim WndCls  As String
    
    Const GW_HWNDNEXT   As Long = 2
    Const WM_CLOSE      As Long = 16
    
       If FileName = "" Then Exit Sub
       
        hWnd = FindWindow(vbNullString, vbNullString)

        Do Until hWnd = 0
            WndCls = String(512, Chr(0))
            ret = GetClassName(hWnd, WndCls, 512)
                If Left(WndCls, ret) = "AcrobatSDIWindow" Then
                    Title = String(512, Chr(0))
                    ret = GetWindowText(hWnd, Title, Len(Title))
                    If InStr(1, Title, FileName, vbTextCompare) Then
                        ret = SendMessage(hWnd, WM_CLOSE, 0, ByVal 0)
                        Found = True
                        Exit Do
                    End If
                End If
            hWnd = GetWindow(hWnd, GW_HWNDNEXT)
        Loop
  
        If Not Found Then MsgBox "The Following PDF Document Was Not Found :" & vbCrLf & vbCrLf & FileName
        
End Sub

Example of Using the Macro

Sub CloseTest()

    ClosePDF "Signed Agreement"
    
End Sub

**Rerock** · 10-09-2014, 08:30 AM

Hi,
Wow; that's incredible!

How do I modify it for 64 Windows?

All of the Private declarations are red in text...

**Leith Ross** · 10-09-2014, 11:09 AM

Hello Rerock,

Here is the 64 bit version of the macro.

' 64 Fit Windows API Calls.
Private Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

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

Private Declare PtrSafe Function GetNextWindow Lib "user32.dll" Alias "GetWindow" (ByVal hwnd As LongPtr, ByVal wFlag As Long) As LongPtr

Private Declare PtrSafe Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr


Sub ClosePDF(ByVal FileName As String)

    Dim Found   As Boolean
    Dim hwnd    As LongPtr
    Dim RefCell As Range
    Dim ret     As LongPtr
    Dim Title   As String
    Dim WndCls  As String
    
    Const GW_HWNDNEXT   As Long = 2
    Const WM_CLOSE      As Long = 16
    
       If FileName = "" Then Exit Sub
       
        hwnd = FindWindow(vbNullString, vbNullString)

        Do Until hwnd = 0
            WndCls = String(512, Chr(0))
            ret = GetClassName(hwnd, WndCls, 512)
                If Left(WndCls, ret) = "AcrobatSDIWindow" Then
                    Title = String(512, Chr(0))
                    ret = GetWindowText(hwnd, Title, Len(Title))
                    If InStr(1, Title, FileName, vbTextCompare) Then
                        ret = SendMessage(hwnd, WM_CLOSE, 0, ByVal 0)
                        Found = True
                        Exit Do
                    End If
                End If
            hwnd = GetWindow(hwnd, GW_HWNDNEXT)
        Loop
  
        If Not Found Then MsgBox "The Following PDF Document Was Not Found :" & vbCrLf & vbCrLf & FileName
        
End Sub

**Rerock** · 10-09-2014, 11:28 AM

Hi,
Thank you! I pasted the code in to a new Module, and tried to assign the macro to a button. For some reason, the macro doesn't appear in the list as an option to select. So, I tried to manually step through the macro (F8), and Windows just makes a dinging noise and does nothing; no debug error, nothing.

Any ideas?

**Leith Ross** · 10-09-2014, 11:38 AM

HEllo Rerock,

VBA will ding if Excel is in Edit Mode. Check that the cursor is not in the Formula Bar.

**Rerock** · 10-09-2014, 12:19 PM

Hi, Attached is an image of what I'm seeing. When I try to assign the macro to a button, I'm not seeing the macro available. When I click on a cell (B25 in the screenshot) and try to manually step through the macro, Excel just dings.
Untitled.jpg

Perhaps there is an Excel and/ or VBA setting I need to adjust in order for it to work?

**Leith Ross** · 10-09-2014, 12:25 PM

Hello Rerock,

Any Sub or Function that takes one or arguments will not show up the available Macros List. But, it is there. Just use the name in your code.

There seems to have been a problem with the picture uploading. It will not display due to an error. Try uploading it again.

You will need to View Code for the button and add a call to the macro manually.

For example:

Sub Buttoon1_Click()
    Call ClosePDF("Signed Agreement")
End Sub

**Rerock** · 10-09-2014, 02:45 PM

Hi,
The image upload is now irrelevant due to your last post... Not sure why it didn't work; it was just a jpg screenshot.

At any rate, I added the 'buttoon1_click' macro, and that seems to work just fine. However, I got a "Compile Error: Type Mismatch" error on this line of the code. "ret" was highlighted. Any idea what may be causing that error?

If Left(WndCls, ret) = "AcrobatSDIWindow" Then

Thanks for all of your help; I really appreciate it!

**Leith Ross** · 10-09-2014, 03:05 PM

Hello Rerock,

Change the Dim statement for ret to this...

    Dim ret     As Long

**Rerock** · 10-09-2014, 03:11 PM

HI,
It looks like that solved that issue, now there is a new one.

ret = GetWindowText(hwnd, Title, Len(Title))

GetWindowText is highlighted, and I'm getting "Compile Error: Sub or Function not defined".

**Leith Ross** · 10-09-2014, 03:17 PM

Hello Rerock,

Okay, I need two ret variables. One for Long data types and a second for LongPtr data types.

Recised Macro Code

' 64 Fit Windows API Calls.
Private Declare PtrSafe Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Private Declare PtrSafe Function GetClassName Lib "user32.dll" Alias "GetClassNameA" (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) 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 SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr


Sub ClosePDF(ByVal FileName As String)

    Dim Found   As Boolean
    Dim hwnd    As Long     ' 64 Bit LongPtr
    Dim RefCell As Range
    Dim retl    As Long
    Dim retlp   As LongPtr  ' 64 Bit LongPtr
    Dim Title   As String
    Dim WndCls  As String
    
    Const GW_HWNDNEXT   As Long = 2
    Const WM_CLOSE      As Long = 16
    
       If FileName = "" Then Exit Sub
       
        hwnd = FindWindow(vbNullString, vbNullString)

        Do Until hwnd = 0
            WndCls = String(512, Chr(0))
            retl = GetClassName(hwnd, WndCls, 512)
                If Left(WndCls, retl) = "AcrobatSDIWindow" Then
                    Title = String(512, Chr(0))
                    retl = GetWindowText(hwnd, Title, Len(Title))
                    If InStr(1, Title, FileName, vbTextCompare) Then
                        retlp = SendMessage(hwnd, WM_CLOSE, 0, ByVal 0)
                        Found = True
                        Exit Do
                    End If
                End If
            hwnd = GetWindow(hwnd, GW_HWNDNEXT)
        Loop
  
        If Not Found Then MsgBox "The Following PDF Document Was Not Found :" & vbCrLf & vbCrLf & FileName
        
End Sub

EDIT: The wrong API call was posted GetWindowNext should be GetWindowText. The change has been made.

**Rerock** · 10-09-2014, 04:10 PM

Hi,
Yes, it looks like you edited the code at 2:22, and I copied the code a couple of minutes before I posted at 2:37. I presume that I copied/ tested the corrected code?

**Rerock** · 10-09-2014, 03:37 PM

I really wish I knew how I could help you out with this; I feel bad.

hwnd = FindWindow(vbNullString, vbNullString)

"Compile Error: Type Mismatch" for FindWindow.

**Leith Ross** · 10-09-2014, 04:00 PM

Hello Rerock,

Did you see the correction I made to Post #12?

**Leith Ross** · 10-09-2014, 04:22 PM

Hello Rerock,

The code you copied should work. I don't know why you would get "Type Mismatch" for FindWindow. The return value is a Long Pointer and hWnd is dimensioned as a LongPtr data type.

**Rerock** · 10-09-2014, 04:52 PM

Yes, I am running 64 bit Office 2010 on 64 bit Win 7 Enterprise.

I have an XLSM inside of a folder on our network path. In the folder with the XLSM is a PDF named "Signed Agreement".

I wish I could help troubleshoot it, but I have no idea what this means:

Originally Posted by Leith Ross

The return value is a Long Pointer and hWnd is dimensioned as a LongPtr data type.

**Kenneth Hobson** · 10-09-2014, 05:28 PM

Leith's approach lets you have good control.

For what you posted initially, just poking a value into a cell and getting it worked fine. I put one more routine in it that I use for text files sometimes.

What else did you need?

Sub Test_IsFileOpen()
   Dim strPDFpath As String
   Dim wbk As Workbook, ws As Worksheet
   
   Range("A1").Value2 = ThisWorkbook.Path & "\" & GetBaseName(ThisWorkbook.FullName) & ".pdf"
   strPDFpath = Range("A1").Value2
   
   If IsFileOpen(strPDFpath) = True Then
    MsgBox "File is open!", , strPDFpath
    Else
    MsgBox "File is not open!", , strPDFpath
   End If
End Sub

Function IsFileOpen(FileName As String) As Variant
  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
  On Error GoTo 0
  Select Case ErrNum
    Case 0
      IsFileOpen = False
    Case 70
      IsFileOpen = True
    Case Else
      If ErrNum = 53 Then IsFileOpen = "Does Not Exit"
  End Select
End Function

'RichardSchollar, http://www.ozgrid.com/forum/showthread.php?t=79132
Function IsFileWriteable(StrFilePath As String) As Boolean
    Dim FileNum As Integer
    IsFileWriteable = False
    FileNum = FreeFile
    On Error Resume Next
    Open StrFilePath For Input Lock Read Write As #FileNum  ' Open file and lock it.
    If Err.Number = 0 Then IsFileWriteable = True 'Can write to file
    Close FileNum
End Function


Function GetBaseName(filespec As String)
  Dim fso As Object, s As String
  Set fso = CreateObject("Scripting.FileSystemObject")
  s = fso.GetBaseName(filespec)
  Set fso = Nothing
  GetBaseName = s
End Function

**Rerock** · 10-10-2014, 09:13 AM

Hi,
Thanks for the reply, I appreciate you taking the time!

I tried the code you posted, and the msgbox always says "File is not open" regardless if the file is actually open or not.

I'm simply trying to get the macro to check and see if - ThisWorkbook.Path & "\Signed Agreement.pdf" - is currently open or not.

If it is open, it'd be cool if it could close it (no need to save), but a msgbox stating it's open works too.
If it's not open, then do nothing.

The code in my first post is what I found googling, and it works fine as long as the file path is embedded in the code; which won't work for this purpose.

**Kenneth Hobson** · 10-11-2014, 09:36 AM

It is left to the user to change the value of strPDFPath if you are not going to use it the way I built it based on your first post. IF you had checked the value of A1 or observed the way it was built in the code, you would have seen that. Obviously, if want to check that file, you can do it like this.

Sub Test_IsFileOpen()
   Dim strPDFpath As String
   Dim wbk As Workbook, ws As Worksheet
   
   'Range("A1").Value2 = ThisWorkbook.Path & "\" & GetBaseName(ThisWorkbook.FullName) & ".pdf"
   'strPDFpath = Range("A1").Value2
   
   strPDFpath = ThisWorkbook.Path & "\Signed Agreement.pdf"
   MsgBox strPDFpath & vbLf & IsFileOpen(strPDFpath)
End Sub

VBA to check if user has pdf file open

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Re: VBA to check if user has pdf file open

Thread Information

Users Browsing this Thread

Similar Threads

Check if a Word File is Open and If Open Close it with Excel VBA.

[SOLVED] Can I disallow the user to open a file if he disable the macro while the file is opening?

Check if file is open and open if closed

Check to see if file is open, and if it is open, activate it

vba to check presence of file and open/not open

Bookmarks

Bookmarks

Posting Permissions