Open only one instance of a text file - vba

Question

In VBA, I have a function that opens a text file. This allows me to place a button on a form and have it show a file when clicked.
The function works fine, however the aforementioned button is clicked multiple times, it will open the same document over and over, rather than just the once.
How can I make it so that a file is only opened once?
Sub OpenTextFile(ByVal filePath As String)
If Len(Dir(filePath)) = 0 Then Exit Sub ' Ensure that the file to open actaully exists
Dim txtFile As Variant
txtFile = Shell("C:\WINDOWS\notepad.exe " & filePath, 1)
End Sub

Answer 1

First check if a Shell ID has previously been assigned to the Workbooks .CustomDocumentProperties property. If it has, then we need to check if that Shell ID instance is still open. We can do that by using the Shell ID and passing it into the WHERE clause of a query against Win32_Process.
If there is no Shell ID assigned to the property, we can go straight to opening the text file. Once we open the text file, we update the .CustomDocumentProperties Property with the new text file Shell ID.
Option Explicit
Sub OpenTextFile()
Dim filePath As String
Dim txtFile As Long
Dim txtOpenCount As Integer
Dim wb As Workbook
Dim wmiService As Object, winQry As Object
Set wb = ThisWorkbook
On Error Resume Next
txtFile = CLng(wb.CustomDocumentProperties("txtFileNum"))
If Err.Number = 0 Then '' If CustomDocumentProperty returned _
without an error then use this to close txt file.
Set wmiService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& ".\root\cimv2")
Set winQry = wmiService.ExecQuery _
("SELECT * from Win32_Process WHERE ProcessID = " & txtFile)
txtOpenCount = winQry.Count
End If
On Error GoTo 0
If txtOpenCount = 0 Then '' If the txtFile is not found, then open.
filePath = "F:\test.txt"
If txtFile > 0 Then
wb.CustomDocumentProperties("txtFileNum").Delete
End If
txtFile = Shell("C:\WINDOWS\notepad.exe " & filePath, vbNormalFocus)
'' Update CustomDocumentProperty with the new txtFile number.
wb.CustomDocumentProperties.Add Name:="txtFileNum", _
Value:=txtFile, _
LinkToContent:=False, _
Type:=msoPropertyTypeString
End If
End Sub
If you are in Access, you can take advantage of the .CreateProperty method, and then the .Properties.Append method. You have to pass the property created from .CreateProperty into the .Properties.Append method. Updated code below.
Option Explicit
Sub OpenTextFile()
Dim filePath As String
Dim txtFile As Long, oTxt As Object
Dim txtOpenCount As Integer
Dim db As Database
Dim wmiService As Object, winQry As Object
Set db = CurrentDb
On Error Resume Next
txtFile = db.Properties("txtFileNum").Value
If Err.Number = 0 Then '' If CustomDocumentProperty returned _
without an error then use this to close txt file.
Set wmiService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& ".\root\cimv2")
Set winQry = wmiService.ExecQuery _
("SELECT * from Win32_Process WHERE ProcessID = " & txtFile)
txtOpenCount = winQry.Count
End If
On Error GoTo 0
If txtOpenCount = 0 Then '' If the txtFile is not found, then open.
filePath = "F:\test.txt"
If txtFile > 0 Then
db.Properties.Delete "txtFileNum"
End If
txtFile = Shell("C:\WINDOWS\notepad.exe " & filePath, vbNormalFocus)
'' Update db Properties with the new txtFile number.
Set oTxt = db.CreateProperty("txtFileNum", dbLong, txtFile, False)
db.Properties.Append oTxt
End If
End Sub

Answer 2

If you need it. Here is a function to see if notepad is running.
Declare these up top.
Private Declare Function OpenProcess Lib "kernel32" ( _
ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" ( _
ByVal hObject As Long) As Long
Private Declare Function EnumProcesses Lib "PSAPI.DLL" ( _
lpidProcess As Long, ByVal cb As Long, cbNeeded As Long) As Long
Private Declare Function EnumProcessModules Lib "PSAPI.DLL" ( _
ByVal hProcess As Long, lphModule As Long, ByVal cb As Long, lpcbNeeded As Long) As Long
Private Declare Function GetModuleBaseName Lib "PSAPI.DLL" Alias "GetModuleBaseNameA" ( _
ByVal hProcess As Long, ByVal hModule As Long, ByVal lpFileName As String, ByVal nSize As Long) As Long
Private Const PROCESS_VM_READ = &H10
Private Const PROCESS_QUERY_INFORMATION = &H400
Then send this the process name. b = IsProcessRunning("notepad.exe")
Private Function IsProcessRunning(ByVal sProcess As String) As Boolean
'Check to see if a process is currently running
Const MAX_PATH As Long = 260
Dim lProcesses() As Long
Dim lModules() As Long
Dim N As Long
Dim lRet As Long
Dim hProcess As Long
Dim sName As String
sProcess = UCase$(sProcess)
ReDim lProcesses(1023) As Long
If EnumProcesses(lProcesses(0), 1024 * 4, lRet) Then
For N = 0 To (lRet \ 4) - 1
hProcess = OpenProcess(PROCESS_QUERY_INFORMATION Or PROCESS_VM_READ, 0, lProcesses(N))
If hProcess Then
ReDim lModules(1023)
If EnumProcessModules(hProcess, lModules(0), 1024 * 4, lRet) Then
sName = String$(MAX_PATH, vbNullChar)
GetModuleBaseName hProcess, lModules(0), sName, MAX_PATH
sName = Left$(sName, InStr(sName, vbNullChar) - 1)
If sProcess = UCase$(sName) Then
IsProcessRunning = True
Exit Function
End If
End If
End If
CloseHandle hProcess
Next N
End If
End Function