避免覆盖Excel共享工作簿中的冲突

Question

一些背景：我构建了一个共享工作簿，由于人们同时在新行中添加项目而遭受了很多保存冲突。

添加新信息行

的过程是通过宏完成的，因此我创建了一个新版本，其中宏在添加信息之前保存工作簿，从而停止将两组数据放入同一行。

我的问题：保存文件确实会减慢宏的速度，因为文件大约 2 MB。

我的问题：有没有办法加快保存过程，或者只用其他人的更改更新工作簿以节省时间？

编辑 #1

更新共享工作表的宏文件具有另一个主要目标。根据本地 excel 文件的数据，我们使用宏生成用于报告的标准文本。

根据共享工作簿中的标志，用户检查问题是否已报告。

此外，此宏由 4 个或更多人同时使用，这会导致冲突。

Answer 1

阻止多个用户同时运行宏似乎有可能（不完全清楚）可以帮助防止该问题。根据OP上面的注释，这里是实现这一目标的代码。该代码将检查 Windows 进程，以查看此宏的另一个实例是否已运行。显然，这个检查应该是OP脚本中发生的第一件事。

Option Explicit
Function RunningInstancesOfThisScript()
    Dim colProcesses
    Dim objProcess
    Dim lScriptCount

    RunningInstancesOfThisScript = 0
    lScriptCount = 0
    ' Get list of running processes using WMI
    Set colProcesses = GetObject("winmgmts:\.rootcimv2").ExecQuery("Select * From Win32_Process")
    For Each objProcess in colProcesses
        If (Instr(1, objProcess.Commandline, WScript.ScriptFullName, vbTextCompare) <> 0) Then
            lScriptCount = lScriptCount + 1
        End If
    Next
    RunningInstancesOfThisScript = lScriptCount 
End Function
Function IsThisScriptAlreadyRunning()
    Dim lScriptCount


    lScriptCount = RunningInstancesOfThisScript()
    If (lScriptCount < 1) Then
        ' This should not happen. There should be at least one instance, the current one
        IsThisScriptAlreadyRunning = False
    ElseIf (lScriptCount = 1) Then
        ' The current instance is the only one
        IsThisScriptAlreadyRunning = False
    Else
        IsThisScriptAlreadyRunning = True
    End If
End Function
If (IsThisScriptAlreadyRunning() = True) Then
    MsgBox "Another instance of this script is already running. This instance will now terminate without making any changes. Please try again after a few minutes.", vbExclamation
    WScript.Quit
Else
    MsgBox "There is no other instance of this script currently running. This instance will now proceed and make the changes needed.", vbInformation
End If

另一种选择是检查 Excel 文件是否已打开。若要运行以下脚本，需要将<FileName>替换为实际文件名。

Option Explicit
Function IsOfficeFileAlreadyOpen(strOfficeFileFullName)
    Dim lPos
    Dim strLockFileFullName

    lPos = InstrRev(strOfficeFileFullName, "", -1, vbBinaryCompare)
    If (lPos = 0) Then
        ' Only file name has been given, no path specified. Must be in current folder. Good luck!
        strLockFileFullName = "~$" & strOfficeFileFullName
    Else
        strLockFileFullName = Left(strOfficeFileFullName, lPos) & "~$" & Mid(strOfficeFileFullName, lPos + 1)
    End If
    IsOfficeFileAlreadyOpen = CreateObject("Scripting.FileSystemObject").FileExists(strLockFileFullName)
End Function
If (IsOfficeFileAlreadyOpen("<FileName>") = True) Then
    MsgBox "The file '" & <FileName> & "' is already open. Please try again once the file is closed.", vbExclamation
    WScript.Quit
Else
    ' Open the file first
    MsgBox "The file '" & "<FileName>" & "' is available and will be processed.", vbInformation
End If

这两种解决方案都容易受到争用条件的影响。