I want to be able to be able to close any open file. How do I do this?
Idea #1 = I've been puzzling over the Help article for Lock and Unlock statements. It would appear that it is possible to close any file in theory? I cant get it to work. 
Idea #2 = If I could be certain that the current window is displaying the open filename (or if I could force this window to be the active window), I could use SendKeys to send Alt + F4 to close the file? (Not the best solution but if Idea #1 doesn't work...)
Below is what I've been playing around with.
Public Sub DevTestOpenPDF()
'/ open PDF.
'/ If PDF is already open, close it and reopen (this is to ensure that we have full control & active focus on this file after Shell.Open)
Dim strFullName As String
Dim objShell As Object
strFullName = fnstrFilePicker("PDF Document", ".PDF")
If Not fnblnExistsFileFolder(strFullName) Then
'prevents trying to open empty string or "False"
Exit Sub
End If
If fnblnIsFileOpen(strFullName) Then
MsgBox "ADD NEW CODE HERE - TO CLOSE FILE", vbInformation
Debug.Assert False
'make sure that the file is closed before continuing
If fnblnIsFileOpen(strFullName) Then
MsgBox "Code failed to close file. Goodbye", vbCritical
Exit Sub
End If
End If
'open file
Set objShell = CreateObject("Shell.Application")
objShell.Open (strFullName)
'to add rest of code here
Set objShell = Nothing
End Sub
Public Function fnblnExistsFileFolder(ByVal strFullName As String) As Boolean
'adapted from function written by Ken Puls (www.excelguru.ca)
If Len(strFullName) > 0 Then
On Error Resume Next
fnblnExistsFileFolder = (Dir(strFullName, 31) <> vbNullString)
On Error GoTo 0
End If
End Function
Public Function fnstrFilePicker(Optional ByVal FileFilter1of2 As String, _
Optional ByVal FileFilter2of2 As String, _
Optional ByRef Title As String = "Open", _
Optional ByVal strInitialPath As String) As String
'TO IMPROVE THIS FUNCTION FOR ARGUMENTS OF MULTIPLE FILTERS OR MULTIPLE EXTS ON 1 FILTER
'To include multiple file types in the same filter, specify multiple filters in the second string and separate them with a semi-colon.
'Replaced omitted arguments with default values as per Help
Dim strFilePath As String
Dim strRestoreCurDir As String
'change curdir if initial path provided
If Not Len(strInitialPath) = 0 Then
strRestoreCurDir = CurDir()
Call SetCurDir(strInitialPath)
End If
'If either FileFilter arguments omitted then replace both with defaults
If Len(FileFilter1of2) = 0 Or Len(FileFilter2of2) = 0 Then
FileFilter1of2 = "All Files (*.*)"
FileFilter2of2 = "*.*"
End If
'file extensions - ensure wildcard in place, add if not
If Not Left$(FileFilter2of2, 2) = "*." Then
Select Case Left$(FileFilter2of2, 1)
Case "."
'only missing wildcard
FileFilter2of2 = "*" & FileFilter2of2
Case Else
'is missing wildcard and extension separator
FileFilter2of2 = "*." & FileFilter2of2
End Select
End If
'merge arguments to create filefilter string
'FileFilter1of2 = FileFilter1of2 & " (" & FileFilter2of2 & "), " & FileFilter2of2
FileFilter1of2 = FileFilter1of2 & ", " & FileFilter2of2
strFilePath = Application.GetOpenFilename(FileFilter:=FileFilter1of2, Title:=Title, MultiSelect:=False)
If Len(strFilePath) = 0 Then
'user cancelled
GoTo ExitProcedure
End If
fnstrFilePicker = strFilePath
ExitProcedure:
Call SetCurDir(strRestoreCurDir)
End Function
Public Function fnblnIsFileOpen(ByVal strFullName As String) As Boolean
Dim lngFF As Long
Dim lngErrNo As Long
On Error Resume Next
lngFF = FreeFile()
Open strFullName For Input Lock Read As #lngFF
Close lngFF
lngErrNo = Err.Number
On Error GoTo 0
fnblnIsFileOpen = (lngErrNo <> 0)
End Function
Bookmarks