从Excel设置VBA ADO连接以访问多个用户和文件的正确方法是什么？

我有几个用于输入数据的excel文件。文件在功能上是相同的，我们的每个服务中心都有一个文件。表单中有一个按钮，用于启动一个宏，该宏将数据转换为另一张表上的表格格式，然后上传到Access db

在我自己的电脑上一切正常。添加新行、更新现有行和删除现有角色。我使用了早期绑定，当我将文件移动到网络驱动器时会出现问题。我设法将文件转换为后期绑定，但随后出现了其他问题

大多数时候，上传到Access是不起作用的，特别是当多个用户试图同时做一些事情时。最常见的错误代码是我没有使用可更新查询，或者此方法不支持向后滚动。我很抱歉没有报告实际的错误代码，但我现在无法复制它们

我的连接代码如下，它是来自不同示例的复制粘贴代码的混合

打开连接和其他预填充

Sub excel2access()

Const adUseClient = 3  
Const adUseServer = 2
Const adLockOptimistic = 3
Const adOpenKeyset = 1
Const adOpenDynamic = 2

Dim oConn As Object
Dim cmd As Object
Dim rs As Object
Dim r As Long
Dim criteria As String
Dim Rng As Range

Set oConn = CreateObject("ADODB.Connection")
Set cmd = CreateObject("ADODB.Command")

oConn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
        "Data Source= '" & Range("dbpath").Value & "\" & Range("dbfile").Value & "' ;"

Set rs = CreateObject("ADODB.Recordset")
rs.CursorLocation = adUseClient
rs.CursorType = adOpenStatic
rs.LockType = adLockOptimistic
rs.Open "Select * from need_rows WHERE service_center = '" & Range("scenter_name").Value & "'", oConn

r = 2 ' the start row in the worksheet

Sheets("data").Select

下面的位查看excel工作表中的数据，并尝试从为该服务中心找到的记录集中查找匹配项。如果未找到匹配项，则创建新记录，如果找到匹配项，则更新旧记录

Do While Len(Range("A" & r).Formula) > 0
    With rs
        criteria = Range("D" & r).Value
        .Find "identifier='" & criteria & "'"
        If (.EOF = True) Or (.BOF = True) Then
            .AddNew ' create a new record
            .Fields("service_center") = Range("scenter_name").Value
            .Fields("product_id") = Range("A" & r).Value
            .Fields("quantity") = Range("B" & r).Value
            .Fields("use_date") = Range("C" & r).Value
            .Fields("identifier") = Range("D" & r).Value
            .Fields("file_type") = Range("file_type").Value
            .Fields("use_type") = Range("E" & r).Value
            .Fields("updated_at") = Now
            .Update             
        Else
            If .Fields("quantity") <> Range("B" & r).Value Then
                .Fields("quantity") = Range("B" & r).Value
                .Fields("updated_at") = Now
                .Update ' stores the new record
            End If                      
        End If
        .MoveFirst 
    End With
    r = r + 1 
Loop

rs.Close
Set rs = Nothing
Set oConn = Nothing

MsgBox "Confirmation message"
End Sub

Do While Len（范围（“A”&r）.Formula）>0
用rs
标准=范围（“D”和r）.值
.Find“identifier=”&条件&“
如果（.EOF=True）或（.BOF=True），则
.AddNew“创建新记录”
.Fields（“服务中心”）=范围（“场景名称”）.Value
.Fields（“产品id”）=范围（“A”&r）.Value
.字段（“数量”）=范围（“B”和“r”）.值
.Fields（“使用日期”）=范围（“C”&r）.Value
.Fields（“标识符”）=范围（“D”&r）.Value
.Fields（“文件类型”）=范围（“文件类型”）.Value
.Fields（“使用类型”）=范围（“E”&r）.Value
.Fields（“更新时间”）=现在
.更新
其他的
如果.Fields（“数量”）范围（“B”和“r”）值，则
.字段（“数量”）=范围（“B”和“r”）.值
.Fields（“更新时间”）=现在
.Update'存储新记录
如果结束
如果结束
.先走一步
以
r=r+1
环
rs.Close
设置rs=无
Set-oConn=无
MsgBox“确认消息”
端接头

编辑：基于barrowc的链接，我将光标类型更改为adOpenStatic。我做了一个测试，有几个用户试图同时上传数据，一切都很顺利。直到有一个用户留在文件中，花了相当长的时间在那里编辑数据，然后试图将数据上载到db，并收到以下错误消息：

再一次，我回到了我的起点

此外，我也愿意接受关于我的代码的总体反馈

我正在使用Office 2010

---

我做错了吗？非常感谢您的帮助。

我觉得Jet对于您的环境来说不够可靠。我经常使用SQL Server/Access数据项目将多个电子表格中的信息整合到一个数据库后端，当您添加六个用户时，该数据库后端不会出现问题。

您也可以尝试使用操作查询。 首先，我将尝试使用更新（您可能需要格式化now值）

---

由于数据库被其他用户锁定，您将遇到很多问题。这有几个原因：

• 据我所知，您没有处理错误。因此，如果您的脚本在连接的中途出错，则会保持打开状态，从而导致锁定问题
• 从外观上看，宏可能会在相当长的时间内保持连接打开（假设没有错误）

创建了许多连接到MS Access数据库的宏之后，我可以直截了当地告诉您。您将遇到很多连接问题，其中数据库被电子表格锁定，而有人由于未处理意外错误（连接从未关闭）等原因而整天/晚上保持打开状态

即使您解决了问题，您所需要的只是一个人使用带有旧代码的电子表格，他们将继续锁定数据库

一个巨大的问题是，如果有人在数据库已经被其他人打开的情况下连接到该数据库，我相信他们会继承已经打开的数据库的连接类型，从而导致写锁的菊花链。然后，您需要确保所有连接都已断开，以便重置连接

您还没有向我们展示如何首先将数据放入电子表格。也许您没有正确地关闭连接，这可能是数据库有时被锁定的潜在原因

有许多不同的事情你可以尝试绕过这一点：

• 最简单的方法是使用MS访问前端+MS访问后端
• 不必按下此按钮并通过连接字符串上传数据，您可以让它将文件保存在一个文件夹中，然后由坐在那里监视该文件夹的ms access数据库进行处理。这意味着您上传的脚本将在MS Access中编写，并且只处理文件。不会像您当前的方法那样即时，但是在这种情况下，所有写连接都将来自同一台机器/用户
• 坚持使用当前的方法：最终您可能会使其达到稳定状态，但这将是一个很大的挫折和努力，因为确定锁定的原因可能并不总是容易的。您至少可以查看当时谁锁定了文件，然后从那里开始工作，但正如前面提到的，他们可能不是锁定的原因。他们可能刚刚继承了锁类型

我个人喜欢使用MS Excel为用户显示MS Access数据，但是

dim count as long
oConn.Execute "UPDATE need_rows SET quantity = " & Range("B" & r).Value & ", updated_at = #" & Now & "# WHERE service_center = '" & Range("scenter_name").Value & "' AND identifier='" & Range("D" & r).Value & "' AND quantity <> " & Range("B" & r).Value", count

if count = 0 then
    count = oConn.Execute "INSERT ...", count
    if count = 0 then
        ' quantity has not changed, so nothing to do
    else
        ' new record inserted
    end if
else
    ' record updated
end if