使用 Excel VBA 更新 Access 数据库表

Question

我的表单中有“上班时间”和“超时”按钮。

我有一个 VBA 模块代码，可以将最后输入的数据/条目的最后一行从 Excel 表保存到 Access 表，并且工作得很好。这在 Excel 表单的 Time In 命令按钮中调用。下面是一个代码片段。

 i = sht.Range("A" & Application.Rows.Count).End(xlUp).Row
    'x = 0
    Do While Len(Range("A" & i).Formula) > 0
' repeat until first empty cell in column A
        With rs
            .AddNew ' create a new record
            .Fields("cYear") = Range("A" & i).Value
            .Fields("MSID") = Range("B" & i).Value
            .Fields("cDate") = Range("C" & i).Value
            .Fields("Time In") = Range("D" & i).value
            .Fields("Time Out") = Range("E" & i).value

            .Range("E" & i) = .Fields("Time Out") 'added column F for ID as per comment below
            .Update
          'stores the new record
    End With
    i = i + 1
    Loop

Access Table 有一个 ID，该 ID 具有自动编号数据类型，其余字段具有文本数据类型。每次用户单击“时间输入”按钮时，当前时间戳都会自动保存到 Excel 表以及 Access 表中，这很好。现在，在单击期间，我在 Excel 和 Access 中将 E 列值编码为空白。

我已经有一个用于更新 Excel 表中超时时间戳的代码。

Excel

我没有用于在 Access 表中保存超时时间戳的代码。我计划制作一个新模块，用于将超时时间戳保存到访问表中。我的问题是，如何编写 E 列超时时间戳更新的代码。

访问

我在下面的超时按钮的新模块中尝试了此操作：

i = sht.Range("A" & Application.Rows.Count).End(xlUp).Row
        'x = 0
        Do While Len(Range("A" & i).Formula) > 0
    ' repeat until first empty cell in column A
            With rs
                .AddNew ' create a new record
                .Fields("Time Out") = Range("E" & i).value
                .Update
              'stores the new record
    End With
   i = i + 1
  Loop

但它的作用是在 Access Table 中创建一个新行。

尝试通过此代码片段进行更新：

i = sht.Range("A" & Application.Rows.count).End(xlUp).Row
'Create the SQL statement to retrieve the table data (the entire table)
    
 SQL = "SELECT * FROM " & accessTable & " WHERE ID = " & Range("F" & i) & _
    Range("B" & i).value = Environ$ & Range("E" & i).value = ""

'Create the ADODB recordset object.
Set rs = CreateObject("ADODB.Recordset")


    Do While Len(Range("A" & i).Formula) > 0
        With rs
            .Fields("Time Out") = Range("E" & i).value:
            .Update
    End With
    i = i + 1
    Loop

还没更新。

请指教。谢谢你。

Answer 1

Sub update()

    Const accessTable = "Table1"

    Dim sht As Worksheet, cn As Object, rs As Object
    Dim ID As Long, i  As Long, SQL As String
    
    Set cn = CreateObject("ADODB.Connection")
    With cn
        .Provider = "Microsoft.ace.OLEDB.12.0"
        .ConnectionString = "Data Source=" & ThisWorkbook.Path & "\Database1.accdb"
        .Open
    End With
    
    Set sht = ThisWorkbook.Sheets("Sheet1")
    With sht
        i = .Cells(.Rows.Count, "A").End(xlUp).Row
        ID = .Cells(i, "F")
    End With
    SQL = " SELECT * FROM " & accessTable & _
          " WHERE ID = " & ID
    
    Set rs = CreateObject("ADODB.Recordset")
    rs.Open SQL, cn, adOpenDynamic, adLockOptimistic
    
    With rs
        .Fields("Time Out") = Range("E" & i).Value
        .update
        .Close
    End With

    cn.Close
    MsgBox "Record ID=" & ID & " updated", vbInformation
    
End Sub