Question

我有一个excel工作簿，它从链接的访问查询中提取数据，用户添加一些必须手动处理的数据，然后单击一个按钮以将更新的数据写入Access中的表。 90％的时间，此代码对我以及至少一个用户而言都非常有效。但是，另一个用户只能在10％的时间内正常工作而不会出错。

Sub SendtoAccess()
'send the updated data to the history table
Dim vDate As Date
Dim sMachine As String
Dim sShift As String
Dim sOperation As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset

'Check that spreadsheet data is valid
If IsError(Cells(27, 5)) Then
    MsgBox "No OEE available, Please follow the steps and try again once an OEE % is displayed."
GoTo Done
End If

Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset

'open database conection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=\\<server>\database.accdb; Persist Security Info=False;"

'open recordset
rs.Open "Tbl_OEE_Daily_History", cn, adOpenKeyset, adLockOptimistic, adCmdTable

'grab operation type
sOperation = Cells(5, 2).Value

'grab shift
sShift = Cells(6, 2).Value

'grab machine
sMachine = Cells(7, 2).Value

'grab date
vDate = Range("cDate")
vDate = DateSerial(Year(vDate), Month(vDate), Day(vDate))

'filter to check for existing record
rs.Filter = "Completed_Date='" & vDate & "' AND Machine_Name='" & sMachine & "' AND Shift_ID='" & sShift & "'"

    If rs.EOF Then
        '^ No record found, lets create a new record

        'remove filter
        rs.Filter = ""

        'create new record
        rs.AddNew     <-- Fails here, sometimes, other times it works fine.
        rs("Completed_Date") = Cells(8, 2).Value
        rs("Machine_Name") = Cells(7, 2).Value
        rs("Operation") = Cells(5, 2).Value
        rs("Shift_ID") = Cells(6, 2).Value

    End If
        'Update fields for new/existing record
        rs("qty_Complete") = Cells(19, 5).Value
        rs("qty_Req'd") = (Cells(19, 5).Value + Cells(20, 5).Value)
        rs("qty_Scrap") = Cells(20, 5).Value
        rs("Ideal_Rate") = Cells(18, 5).Value
        rs("Downtime_mins") = Cells(17, 5).Value
        rs("Shift_Length_mins") = Cells(13, 5).Value
        rs("Pieces_per_Hour") = (Cells(27, 5).Value / (Cells(26, 5).Value / 60))
        rs("OEE") = Cells(7, 6).Value
        rs.Update

'clean up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing

ActiveWorkbook.RefreshAll

Done:

End Sub

我很茫然。

使用VBA从Excel更新Access表。有时获取“当前记录集不支持更新”

0 个答案: