Disable opening Excel from VBA

[Hat Man]

Is ther any way to prevent users from opening an other Exell workbook from VBA. I have VBA code; and while running, i would like to prevent the users from opening another workbook while this particular one is open/running. Can this be done from within VBA or a macro.

Thanks

 

[Joe4]

I don't think it would be possible to do from Excel VBA, as if you open a whole new instance of Excel (rather than opening a workbook from the same instance of Excel), the two instances are totally unrelated, so any VBA in one instance would not affect anything in your other Excel instance.

If it is possible, I would think it would have to be something at a "higher" level than Excel on your PC (and I don't have the foggiest idea how to do anything like that).

 

[mikerickson]

You might have the Open event of the key Workbook create an Application level WorkBookOpen event that closed every workbook that someone attempted to open.

 

[Ruddles]

The VBA code could check the active processes and remember the process ids of all the instances of EXCEL.EXE which were running, then kill any new ones which appeared.

 

[Joe4]

The VBA code could check the active processes and remember the process ids of all the instances of EXCEL.EXE which were running, then kill any new ones which appeared.

That is very interesting. I did not even know that was possible.
What would that code look like?

 

[mikerickson]

In the key workbook, put this in a class module

Public WithEvents myApp As Application

Private Sub myApp_WorkbookOpen(ByVal Wb As Workbook)
    Wb.Close
End Sub

then running Test (in a normal module) will prevent any other workbook from being opened. It will not close any existing workbooks or prevent the creation of a New workbook. (The sub Un-Test will remove the blockage)

Public aApp As Class1

Sub Test()
    Set aApp = New Class1
    Set aApp.myApp = Application
End Sub

Sub Un-Test()
    Set aApp = Nothing
End Sub

 

[Joe4]

Mike,

I tried your code and found two issues, on minor and one major:

Minor:
Excel doesn't like dashes in Procedure names, so I re-named "Un-Test" to "UnTest" to get it to work.

Major:
It works fine if you are trying to open other Excel files from that particular instance of Excel, but it does NOT prevent other Excel files from opening from other instances of Excel (if you open a new instance of Excel on the computer).

 

[mikerickson]

The majorness of the new instance depends on the OP's need.
In general, I dislike restricting users. Doing something like disabling Open can:
1) annoy them
2) cause them to think something is broken and call IT.

 

[Joe4]

I was just going on what the original request was:

Is ther any way to prevent users from opening an other Exell workbook from VBA.

Since there are two ways to main ways to open a workbook in Excel, from the same instance of Excel or from a new instance, I was assuming that they would want to prevent both possibilities.

But I do agree with you in that restricting users can cause unwanted attention from them. In situations like the OP described, if at all possible, I would investigate scheduling the tasks to run off-hours where there wouldn't be any interference from users trying to do their jobs.

 

[Ruddles]

That is very interesting. I did not even know that was possible.
What would that code look like?

It's clunky but I knocked it together fairly quickly as a proof of concept. Sling this lot into a new general code module:-

[FONT=Fixedsys]Option Explicit[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Public PermittedProcesses As String
Public process() As Variant
Public iLimit As Integer
Public KillCount As Integer[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Private Const TH32CS_SNAPPROCESS As Long = 2&
Private Const PROCESS_ALL_ACCESS = &H1F0FFF
Private Const MAX_PATH As Integer = 260[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Private Type PROCESSENTRY32
  dwSize As Long
  cntUsage As Long
  th32ProcessID As Long
  th32DefaultHeapID As Long
  th32ModuleID As Long
  cntThreads As Long
  th32ParentProcessID As Long
  pcPriClassBase As Long
  dwFlags As Long
  szexeFile As String * MAX_PATH
End Type[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Private Declare Sub CloseHandle Lib "kernel32" (ByVal hPass As Long)[/FONT]
[FONT=Fixedsys]Private Declare Function OpenProcess Lib "kernel32.dll" (ByVal dwDesiredAccess As Long, ByVal blnheritHandle As Long, ByVal dwAppProcessId As Long) As Long[/FONT]
[FONT=Fixedsys]Private Declare Function ProcessFirst Lib "kernel32.dll" _
    Alias "Process32First" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long[/FONT]
[FONT=Fixedsys]Private Declare Function ProcessNext Lib "kernel32.dll" _
    Alias "Process32Next" (ByVal hSnapshot As Long, uProcess As PROCESSENTRY32) As Long[/FONT]
[FONT=Fixedsys]Private Declare Function CreateToolhelpSnapshot Lib "kernel32.dll" _
    Alias "CreateToolhelp32Snapshot" (ByVal lFlags As Long, lProcessID As Long) As Long[/FONT]
[FONT=Fixedsys]Private Declare Function TerminateProcess Lib "kernel32.dll" (ByVal ApphProcess As Long, ByVal uExitCode As Long) As Long[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Public Sub InitialisePermittedProcesses(argProcessImageName As String)[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]  Dim hSnapshot As Long
  Dim procEntry As PROCESSENTRY32
  Dim result As Long
  Dim process(3) As Variant
  Dim iPtr As Integer
    
  hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0)
  If hSnapshot = -1 Then Err.Raise 999, , "Unable to get process snapshot"
  procEntry.dwSize = Len(procEntry)
  
  PermittedProcesses = ""
  result = ProcessFirst(hSnapshot, procEntry)
  Do While result
    process(0) = procEntry.th32ProcessID
    process(1) = Left$(procEntry.szexeFile, InStr(procEntry.szexeFile & vbNullChar, vbNullChar) - 1)
    process(2) = procEntry.cntThreads
    process(3) = procEntry.th32ParentProcessID
    If LCase(process(1)) = LCase(argProcessImageName) Then
      PermittedProcesses = PermittedProcesses & "/" & CStr(process(0)) & "/"
    End If
    result = ProcessNext(hSnapshot, procEntry)
    iPtr = iPtr + 1
  Loop
  
  CloseHandle hSnapshot
    
End Sub[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Public Sub KillNonPermittedProcesses(argProcessImageName As String)[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]  Dim hSnapshot As Long
  Dim procEntry As PROCESSENTRY32
  Dim result As Long
  Dim process(3) As Variant
  Dim iPtr As Integer
    
  hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0)
  If hSnapshot = -1 Then Err.Raise 999, , "Unable to get process snapshot"
  procEntry.dwSize = Len(procEntry)
  
  result = ProcessFirst(hSnapshot, procEntry)
  Do While result
    process(0) = procEntry.th32ProcessID
    process(1) = Left$(procEntry.szexeFile, InStr(procEntry.szexeFile & vbNullChar, vbNullChar) - 1)
    process(2) = procEntry.cntThreads
    process(3) = procEntry.th32ParentProcessID
    If LCase(process(1)) = LCase(argProcessImageName) Then
      If InStr(PermittedProcesses, "/" & CStr(process(0)) & "/") = 0 Then
        Call EndProcess(procEntry.th32ProcessID)
      End If
    End If
    result = ProcessNext(hSnapshot, procEntry)
    iPtr = iPtr + 1
  Loop
  
  CloseHandle hSnapshot
    
End Sub[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Public Sub EndProcess(argProcess As Long)[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]  Dim uProcess  As PROCESSENTRY32
  Dim RProcessFound As Long
  Dim hSnapshot As Long
  Dim SzExename As String
  Dim ExitCode As Long
  Dim MyProcess As Long
  Dim AppKill As Boolean
  Dim i As Integer
  Dim WinDirEnv As String
  
    uProcess.dwSize = Len(uProcess)
    hSnapshot = CreateToolhelpSnapshot(TH32CS_SNAPPROCESS, 0&)
    RProcessFound = ProcessFirst(hSnapshot, uProcess)
    Do
      i = InStr(1, uProcess.szexeFile, Chr(0))
      SzExename = LCase$(Left$(uProcess.szexeFile, i - 1))
      WinDirEnv = Environ("Windir") + "\"
      WinDirEnv = LCase$(WinDirEnv)
      ' check for a process specified by process id and kill it
      If argProcess = uProcess.th32ProcessID Then
        MyProcess = OpenProcess(PROCESS_ALL_ACCESS, False, uProcess.th32ProcessID)
        AppKill = TerminateProcess(MyProcess, ExitCode)
        Call CloseHandle(MyProcess)
      End If
      RProcessFound = ProcessNext(hSnapshot, uProcess)
    Loop While RProcessFound
    Call CloseHandle(hSnapshot)
  
End Sub[/FONT]

When you start your main process - the one during which you don't want any other instances of Excel to start - you Call InitialisePermittedProcesses("excel.exe") once. This creates a string containing all the process ids belonging to any instances of Excel which are already running and stores them in PermittedProcesses.

Then at any time (regular intervals, or as required) during your main process you Call KillNonPermittedProcesses("excel.exe"): this subroutine looks for any instances of Excel which are running but whose process ids weren't stored when InitialisePermittedProcesses was run. If you check frequently enough, the instance is killed before it even becomes visible.

Test rig:-

[FONT=Fixedsys]Option Explicit[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]Public Sub TestDriver()[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]  Call InitialisePermittedProcesses("excel.exe")
  
  MsgBox "Only the following instances of Excel will be permitted:-" & Space(10) & vbCrLf & vbCrLf _
       & Space(10) & Replace(Replace(PermittedProcesses, "//", ", "), "/", "") & Space(10) & vbCrLf & vbCrLf _
       & "Press OK to start monitoring and Ctrl-Break to stop monitoring" & Space(10)
  
  Do
    Call KillNonPermittedProcesses("excel.exe")
    DoEvents
  Loop[/FONT]
[FONT=Fixedsys][/FONT] 
[FONT=Fixedsys]End Sub[/FONT]
[FONT=Fixedsys][/FONT]

Set that running and then try to open another instance of Excel. Of course it won't stop someone opening another workbook in the same instance of Excel but I think Mike has covered that angle.