Excel VBA从中央服务器获取命令的最佳方法

我确定这样的事情之前已经被问过了，但我猜我没有search正确的关键词，因为我找不到一个好的答案。

我创build了一个由我的整个团队使用的Excel加载项。 我保留最新版本的networking驱动器，每当有人重新打开Excel，加载项检查是否有一个新的版本，并自动更新自己。

我想要做的是能够发送命令到加载项单独执行。 例如，如果我有一个重要的更新推送，而不是等待每个用户重新打开Excel，我希望能够保存命令在networking驱动器上的文本文件（即“USER：ALL; COMMAND：UPDATE“），每个用户的加载项会自动提取该命令，并在合理的时间范围内对其进行处理。

我的问题是完成这个最好的方法是什么？ 我可以想到两种解决scheme，我也不喜欢。

潜在的解决scheme＃1 – 在“Worksheet_Calculate”或类似的地方，让它检查新的命令并处理它find的任何东西。 但是，这似乎是矫枉过正，可能会检查太多。

潜在的解决scheme＃2 – 使用无限的Application.OnTime调用链，以便每X秒/分钟检查新的中央命令，并将处理所发现的任何内容。 但是，我发现Application.OnTime是时髦和不可靠的。

有任何想法吗？ 我觉得做一个类的东西是要走的路，但我没有太多的经验。

谢谢！

Answer 1

好的，我最终select了潜在解决scheme＃1。

本书中的代码

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 

MCentralCommands中的代码 请注意，本模块中对其他模块的唯一引用是一些全局variables，如gsAPP_MASTER_PATH。 此代码使用本书中的MErrorHandler系统： 专业Excel开发 。

 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