多终端同时操作Excel主文档的VBA解决方案咨询

嘿，这个多用户同时操作Excel主文档的问题确实挺头疼的，我来给你几个实用的解决方案，帮你绕过Excel的锁定限制：

你的现有代码是直接打开整个工作簿，这会触发Excel的文件锁定，导致多用户冲突。用ADO（ActiveX Data Objects）可以把Excel文件当作数据库来操作，不用打开Excel界面就能读写数据，多用户同时操作的冲突会大幅降低。

下面是修改后的客户端代码：

Sub Button1_Click()
    Dim conn As Object
    Dim rs As Object
    Dim masterPath As String
    Dim userName As String
    
    ' 获取用户输入，处理空输入的情况
    userName = InputBox("Enter your name")
    If userName = "" Then
        MsgBox "请输入有效的姓名！"
        Exit Sub
    End If
    
    ' 替换成你的服务器上主清单的实际路径
    masterPath = "\\ServerName\SharedFolder\Master List.xlsm"
    
    ' 初始化ADO对象
    Set conn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")
    
    ' 错误处理，避免程序崩溃
    On Error GoTo Cleanup
    
    ' 打开与Excel文件的连接（适配Excel 2007及以上版本）
    conn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
              "Data Source=" & masterPath & ";" & _
              "Extended Properties=""Excel 12.0 Macro;HDR=YES;"";"
    
    ' 插入新数据到A列的下一行
    ' 注意：把单引号替换成双引号，避免SQL语法错误
    conn.Execute "INSERT INTO [Sheet1$] (A) VALUES ('" & Replace(userName, "'", "''") & "')"
    
    MsgBox "数据已成功添加到主清单！"
    
Cleanup:
    ' 清理资源，关闭连接
    If Not rs Is Nothing Then rs.Close
    If Not conn Is Nothing Then conn.Close
    Set rs = Nothing
    Set conn = Nothing
    
    ' 如果出错，提示用户
    If Err.Number <> 0 Then
        MsgBox "操作失败：" & Err.Description
    End If
End Sub

注意事项：

• 确保客户端电脑安装了Microsoft.ACE.OLEDB.12.0驱动（一般Office默认会装，没有的话可以下载安装）
• [Sheet1$]要替换成你主清单里实际的工作表名称
• 如果主清单没有表头，把连接字符串里的HDR=YES改成HDR=NO

Excel自带共享工作簿功能，允许多用户同时编辑，但这个功能有不少局限性（比如不支持部分VBA功能、文件容易损坏），只适合简单的场景。

设置步骤：

• 打开服务器上的Master List.xlsm
• 切换到「审阅」选项卡，点击「共享工作簿」
• 在弹出的对话框中勾选「允许多用户同时编辑，同时允许工作簿合并」
• 保存文件，之后多用户就能同时打开编辑了

不过这个方法还是可能出现写入冲突，建议给你的现有代码加上错误处理，比如捕获文件锁定错误：

Sub Button1_Click()
    Dim userName As String
    Dim masterWB As Workbook
    Dim lastRow As Long
    Dim filePath As String
    
    userName = InputBox("Enter your name")
    If userName = "" Then Exit Sub
    
    filePath = "\\ServerName\SharedFolder\Master List.xlsm"
    
    On Error Resume Next
    Set masterWB = Workbooks.Open(filePath, ReadOnly:=False)
    On Error GoTo 0
    
    If masterWB Is Nothing Then
        MsgBox "文件正在被其他用户占用，请稍后再试！"
        Exit Sub
    End If
    
    With masterWB.Sheets("Sheet1")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        .Range("A" & lastRow) = userName
    End With
    
    masterWB.Save
    masterWB.Close
    Set masterWB = Nothing
    MsgBox "数据已添加！"
End Sub

如果不想大幅修改现有代码，可以在打开文件前检测是否被锁定，并尝试重试，减少冲突概率。

示例代码：

Sub Button1_Click()
    Dim userName As String
    Dim masterWB As Workbook
    Dim lastRow As Long
    Dim filePath As String
    Dim attempts As Integer
    
    userName = InputBox("Enter your name")
    If userName = "" Then Exit Sub
    
    filePath = "\\ServerName\SharedFolder\Master List.xlsm"
    attempts = 0
    
    ' 最多尝试5次，每次间隔5秒
    Do While attempts < 5
        On Error Resume Next
        Set masterWB = Workbooks.Open(filePath, ReadOnly:=False, Notify:=False)
        On Error GoTo 0
        
        If Not masterWB Is Nothing Then Exit Do
        
        attempts = attempts + 1
        MsgBox "文件被占用，" & (5 - attempts) & "秒后重试..."
        Application.Wait Now + TimeValue("00:00:05")
    Loop
    
    If masterWB Is Nothing Then
        MsgBox "文件长时间被占用，请稍后再试！"
        Exit Sub
    End If
    
    ' 写入数据
    With masterWB.Sheets("Sheet1")
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
        .Range("A" & lastRow) = userName
    End With
    
    masterWB.Save
    masterWB.Close
    Set masterWB = Nothing
    MsgBox "数据已成功添加！"
End Sub

这个方法只是缓解冲突，无法完全避免多用户同时写入导致的数据覆盖，所以还是优先推荐方案1。

内容的提问来源于stack exchange，提问作者Matthew Struttmann