Best Method For Excel VBA to Get Commands From Central Server - vba

Question

I'm sure something like this has been asked before but I guess I'm not searching the right keywords because I couldn't find a good answer.
I have created an Excel Add-In used by my entire team. I keep the most recent version on the Network drive and whenever someone re-opens Excel, the add-in checks if there is a new version and updates itself automatically.
What I'd like to do is be able to send commands to the add-ins individually to execute. For instance, if I have an important update to push, rather than waiting for each user to re-open Excel, I'd like to be able to save the command on the Network drive in a text file (i.e. "USER: ALL; COMMAND: UPDATE") and each user's add-in would automatically pick-up that command and process it within a reasonable time frame.
My question is what's the best method for accomplishing this? I can think of two solutions off the top of my head, neither of which I like.
Potential Solution #1 - In 'Worksheet_Calculate' or some similar place, have it check for new commands and process any it finds. However that seems like overkill and would potentially be checking far too often.
Potential Solution #2 - Use an infinite chain of Application.OnTime calls so that every X seconds/minutes it's checking for new central commands and will process any it finds. However I find Application.OnTime to be funky and unreliable.
Any ideas? I feel like doing something with a Class is the way to go but I don't have much experience with those.
Thanks!

Answer 1

OK, I ended up going with Potential Solution #1.
Code in ThisWorkbook
Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
If mdtLastCheck = 0 Or DateDiff("s", mdtLastCheck, Now) > miCHECK_FREQUENCY_SECONDS Then
mdtLastCheck = Now
CheckForCommandsAndRun
End If
End Sub
Code in MCentralCommands
Note the only reference in this module to other modules is to a couple of global variables like gsAPP_MASTER_PATH. This code uses the MErrorHandler system from this book: Professional Excel Development.
Option Explicit
' Description: This module contains
'
Private Const msModule As String = "MCentralCommands"
Private Const msCOMMANDS_FOLDER As String = "Commands\"
Private Const msCOMMAND_NAME_FORUSER As String = "CMD_USERNAME_*"
Private Const msCOMMAND_NAME_FORALL As String = "CMD_ALL_*"
Public Const miCHECK_FREQUENCY_SECONDS = 10
Public mdtLastCheck As Date
Sub CheckForCommandsAndRun()
' *********************************************
' Entry-Point Procedure Code Start
' *********************************************
Const sSource As String = "CheckForCommandsAndRun"
On Error GoTo ErrorHandler
' *********************************************
' *********************************************
Dim sCommands() As String
If Not bGetNewCommands(sCommands) Then Err.Raise glHANDLED_ERROR
If Not bProcessAllCommands(sCommands) Then Err.Raise glHANDLED_ERROR
' *********************************************
' Entry-Point Procedure Code Exits
' *********************************************
ErrorExit:
Exit Sub
ErrorHandler:
If bCentralErrorHandler(msModule, sSource, , True) Then
Stop
Resume
Else
Resume ErrorExit
End If
End Sub
Private Function bGetNewCommands(sCommands() As String) As Boolean
' *********************************************
' **** Function Code Start
' *********************************************
Dim bReturn As Boolean
Const sSource As String = "bGetNewCommands()"
On Error GoTo ErrorHandler
bReturn = True
' *********************************************
' *********************************************
Dim sCommandPath As String, sUser As String
sCommandPath = gsAPP_MASTER_PATH & msCOMMANDS_FOLDER
sUser = UCase(Application.UserName)
Dim iCommandCount As Integer
Dim vFile As Variant
vFile = Dir(sCommandPath)
While (vFile <> "")
If vFile Like msCOMMAND_NAME_FORALL Or _
vFile Like Replace(msCOMMAND_NAME_FORUSER, "USERNAME", sUser) Then _
ReDim Preserve sCommands(0 To iCommandCount)
sCommands(iCommandCount) = vFile
iCommandCount = iCommandCount + 1
End If
vFile = Dir
Wend
' *********************************************
' Function Code Exits
' *********************************************
ErrorExit:
bGetNewCommands = bReturn
Exit Function
ErrorHandler:
bReturn = False
If bCentralErrorHandler(msModule, sSource) Then
Stop
Resume
Else
Resume ErrorExit
End If
End Function
Private Function bProcessAllCommands(sCommands() As String) As Boolean
' *********************************************
' **** Function Code Start
' *********************************************
Dim bReturn As Boolean
Const sSource As String = "bProcessAllCommands()"
On Error GoTo ErrorHandler
bReturn = True
' *********************************************
' *********************************************
Dim sCommandPath As String, sUser As String
sCommandPath = gsAPP_MASTER_PATH & msCOMMANDS_FOLDER
sUser = UCase(Application.UserName)
Dim iCmd As Integer
For iCmd = LBound(sCommands) To UBound(sCommands)
If Not bProcessCommand(sCommands(iCmd)) Then Err.Raise glHANDLED_ERROR
Next
' *********************************************
' Function Code Exits
' *********************************************
ErrorExit:
bProcessAllCommands = bReturn
Exit Function
ErrorHandler:
bReturn = False
If bCentralErrorHandler(msModule, sSource) Then
Stop
Resume
Else
Resume ErrorExit
End If
End Function
Private Function bProcessCommand(sCommand As String, Optional bDeleteIfUserCmd As Boolean = True) As Boolean
' *********************************************
' **** Function Code Start
' *********************************************
Dim bReturn As Boolean
Const sSource As String = "bProcessCommand()"
On Error GoTo ErrorHandler
bReturn = True
' *********************************************
' *********************************************
Dim sCommandPath As String, sUser As String
sCommandPath = gsAPP_MASTER_PATH & msCOMMANDS_FOLDER
sUser = UCase(Application.UserName)
Dim bHaveIRun As Boolean, bCommandSuccessful As Boolean
If Not bHaveIRunCommand(sCommand, bHaveIRun) Then Err.Raise glHANDLED_ERROR
If Not bHaveIRun Then
If Not bRunCommand(sCommand, bCommandSuccessful) Then Err.Raise glHANDLED_ERROR
If bCommandSuccessful Then
If Not bMarkCommandAsRan(sCommand) Then Err.Raise glHANDLED_ERROR
MLog.Log "Ran: " & sCommand
End If
End If
' *********************************************
' Function Code Exits
' *********************************************
ErrorExit:
bProcessCommand = bReturn
Exit Function
ErrorHandler:
bReturn = False
If bCentralErrorHandler(msModule, sSource) Then
Stop
Resume
Else
Resume ErrorExit
End If
End Function
Private Function bRunCommand(sCommand As String, bCommandSuccessful As Boolean) As Boolean
' *********************************************
' **** Function Code Start
' *********************************************
Dim bReturn As Boolean
Const sSource As String = "bRunCommand()"
On Error GoTo ErrorHandler
bReturn = True
' *********************************************
' *********************************************
Dim sCommandName As String
sCommandName = Replace(Mid(sCommand, InStrRev(sCommand, "_") + 1), ".txt", "")
Select Case UCase(sCommandName)
Case "MSGBOX":
Dim sMsgBoxText As String
If Not bGetParameterFromCommand(sCommand, "Msg", sMsgBoxText) Then Err.Raise glHANDLED_ERROR
MsgBox sMsgBoxText
bCommandSuccessful = True
Case "UPDATE":
CheckForUpdates False
bCommandSuccessful = True
Case "OLFLDRS":
UpdateSavedOutlookFolderList
bCommandSuccessful = True
End Select
' *********************************************
' Function Code Exits
' *********************************************
ErrorExit:
bRunCommand = bReturn
Exit Function
ErrorHandler:
bReturn = False
If bCentralErrorHandler(msModule, sSource) Then
Stop
Resume
Else
Resume ErrorExit
End If
End Function
Private Function bGetParameterFromCommand(sCommand As String, sParameterName As String, sParameterReturn As String) As Boolean
' *********************************************
' **** Function Code Start
' *********************************************
Dim bReturn As Boolean
Const sSource As String = "bGetParameterFromCommand()"
On Error GoTo ErrorHandler
bReturn = True
' *********************************************
' *********************************************
Dim sCommandPath As String, sUser As String
sCommandPath = gsAPP_MASTER_PATH & msCOMMANDS_FOLDER
sUser = UCase(Application.UserName)
Dim sFilePath As String, sParameterText() As String, sTextLine As String
Dim iLineCount As Integer
sFilePath = sCommandPath & sCommand
Dim bBegin As Boolean
Open sFilePath For Input As #1
Do Until EOF(1)
Line Input #1, sTextLine
If bBegin Then If Left(sTextLine, 1) = ":" Then bBegin = False
If sTextLine Like "*:Parameters:*" Then
bBegin = True
End If
If bBegin Then
ReDim Preserve sParameterText(0 To iLineCount)
sParameterText(iLineCount) = sTextLine
iLineCount = iLineCount + 1
End If
Loop
Close #1
Dim iParameterCounter As Integer
For iParameterCounter = LBound(sParameterText) To UBound(sParameterText)
If sParameterText(iParameterCounter) Like sParameterName & ": *" Then _
sParameterReturn = Mid(sParameterText(iParameterCounter), InStr(1, sParameterText(iParameterCounter), " ") + 1)
Next
' *********************************************
' Function Code Exits
' *********************************************
ErrorExit:
bGetParameterFromCommand = bReturn
Exit Function
ErrorHandler:
bReturn = False
If bCentralErrorHandler(msModule, sSource) Then
Stop
Resume
Else
Resume ErrorExit
End If
End Function
Private Function bHaveIRunCommand(sCommand As String, bHaveIRun As Boolean) As Boolean
' *********************************************
' **** Function Code Start
' *********************************************
Dim bReturn As Boolean
Const sSource As String = "bHaveIRunCommand()"
On Error GoTo ErrorHandler
bReturn = True
' *********************************************
' *********************************************
Dim sCommandPath As String, sUser As String
sCommandPath = gsAPP_MASTER_PATH & msCOMMANDS_FOLDER
sUser = UCase(Application.UserName)
Dim sFile As String, sText As String, sTextLine As String
sFile = sCommandPath & sCommand
Dim bBegin As Boolean
Open sFile For Input As #1
Do Until EOF(1)
Line Input #1, sTextLine
If bBegin Then If Left(sTextLine, 1) = ":" Then bBegin = False
If sTextLine Like "*:Run By Users:*" Then bBegin = True
If bBegin Then
sText = sText & sTextLine
End If
Loop
Close #1
bHaveIRun = sText Like "*" & sUser & "*"
' *********************************************
' Function Code Exits
' *********************************************
ErrorExit:
bHaveIRunCommand = bReturn
Exit Function
ErrorHandler:
bReturn = False
If bCentralErrorHandler(msModule, sSource) Then
Stop
Resume
Else
Resume ErrorExit
End If
End Function
Private Function bMarkCommandAsRan(sCommand As String) As Boolean
' *********************************************
' **** Function Code Start
' *********************************************
Dim bReturn As Boolean
Const sSource As String = "bMarkCommandAsRan()"
On Error GoTo ErrorHandler
bReturn = True
' *********************************************
' *********************************************
Dim sCommandPath As String, sUser As String
sCommandPath = gsAPP_MASTER_PATH & msCOMMANDS_FOLDER
sUser = UCase(Application.UserName)
Dim sFilePath As String, sRanText As String, sTextLine As String, bHaveIRun As Boolean
Dim sFullText() As String, iLineCount As Integer, iRunBy As Integer
sFilePath = sCommandPath & sCommand
Dim bBegin As Boolean
Open sFilePath For Input As #1
Do Until EOF(1)
Line Input #1, sTextLine
ReDim Preserve sFullText(0 To iLineCount)
sFullText(iLineCount) = sTextLine
iLineCount = iLineCount + 1
If bBegin Then If Left(sTextLine, 1) = ":" Then bBegin = False
If sTextLine Like "*:Run By Users:*" Then
bBegin = True
iRunBy = iLineCount - 1
End If
If bBegin Then
sRanText = sRanText & sTextLine
End If
Loop
Close #1
bHaveIRun = sRanText Like "*" & sUser & "*"
If Not bHaveIRun Then
Dim iCounter As Integer
Open sFilePath For Output As #1
For iLineCount = LBound(sFullText) To UBound(sFullText)
Print #1, sFullText(iLineCount)
If iLineCount = iRunBy Then _
Print #1, sUser
Next
Close #1
End If
' *********************************************
' Function Code Exits
' *********************************************
ErrorExit:
bMarkCommandAsRan = bReturn
Exit Function
ErrorHandler:
bReturn = False
If bCentralErrorHandler(msModule, sSource) Then
Stop
Resume
Else
Resume ErrorExit
End If
End Function