如何使用VBA从Excel更新Access数据库?

时间:2019-07-14 13:53:14

标签: excel vba ms-access access-vba

我想每天(使用excel)将来自不同部门的多个数据添加到访问数据库中。每个部门将在同一行的特定单元格中添加特定数据的位置(每天一次)。
数据库结构:

time_stamp    cpi_qty    cpi_value    rm_qty    rm_value

这是我的代码:

Private Sub cpi_send_data_Click()
'Declaring the necessary variables.
        Dim cnn As ADODB.Connection 'dim the ADO collection class
        Dim rs As ADODB.Recordset 'dim the ADO recordset class
        Dim dbPath As String
        Dim SQL As String
        Dim i As Integer
        Dim item As String

        'add error handling
        On Error GoTo errHandler:        

        'Variables
        dbPath = Sheets("Export").Range("I3").Value

        'Initialise the collection class variable
        Set cnn = New ADODB.Connection
        'Connection class is equipped with a —method— named Open
        '—-4 aguments—- ConnectionString, UserID, Password, Options
        'ConnectionString formula—-Key1=Value1;Key2=Value2;Key_n=Value_n;
        cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath

        'Create the ADODB recordset object.
        Set rs = New ADODB.Recordset 'assign memory to the recordset        

        'ConnectionString Open '—-5 arguments—-
        'Source, ActiveConnection, CursorType, LockType, Options

此代码工作正常,但我只想删除以下部分,如果删除此部分,则会引发错误(找不到对象)。我在哪里犯错?

        rs.Open "tbl_bdm", ActiveConnection:=cnn, _
        CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
        Options:=adCmdTable

        'Check if the recordset is empty.
        If rs.EOF And rs.BOF Then
            'Close the recordet and the connection.
            rs.Close
            cnn.Close
            'clear memory
            Set rs = Nothing
            Set cnn = Nothing
            'Enable the screen.
            Application.ScreenUpdating = True
            'In case of an empty recordset display an error.
            MsgBox "There are no records in the recordset!", vbCritical, "No Records"
            Exit Sub
        End If
        'MsgBox (rs("Standard").Value)

        rs.Close

我想不需要上面的那部分

        Dim curr_date As Date
        curr_date = Date
         'Create the SQL statement to retrieve the data from table.
                SQL = "SELECT * FROM tbl_bdm WHERE time_stamp =#" & curr_date & "#"   '& Format(curr_date, dd - mm - yyyy)
          rs.Open SQL, cnn

          'Check if the recordset is empty.
            If rs.EOF And rs.BOF Then
                'Close the recordset and the connection.
                'rs.Close
                'cnn.Close
                'clear memory
                'Set rs = Nothing
                'Set cnn = Nothing
                'Enable the screen.
                Application.ScreenUpdating = True
                'In case of an empty recordset display an error.
                MsgBox "There are no records in the recordset!", vbCritical, "No Records"

                'rs.Open "tbl_bdm", ActiveConnection:=cnn, _
                'CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
                'Options:=adCmdTable

                With rs
                    .AddNew
                    .Fields("time_stamp").Value = Date
                    '.Fields("Surname").Value = Arec2
                End With
                rs.Update

                'Exit Sub
            End If

        If rs("time_stamp").Value = Date Then
            'SQL = " UPDATE tbl_bdm SET time_stamp = '10-Jul-19' WHERE (((time_stamp)='7/11/2019'));"
            rs.Fields("daily_sales_visit").Value = sales_form.TextBox2
            rs.Fields("mtd_sales_visit").Value = sales_form.TextBox3

            rs.Update
            MsgBox "if part working"
            'DoCmd.RunSql SQL
            Else
                With rs
                    .AddNew
                    .Fields("time_stamp").Value = Date
                    '.Fields("Surname").Value = Arec2
                End With
                rs.Update
                MsgBox "else part working"

        End If

            'MsgBox (result_data)
            'Write the reocrdset values in the sheet.
            'Sheet2.Range("a2").CopyFromRecordset rs

            'Close the recordset and the connection.
            rs.Close
            cnn.Close
            'clear memory
            Set rs = Nothing
            Set cnn = Nothing

            'Update the worksheet
            Application.ScreenUpdating = True

            'Inform the user that the macro was executed successfully.
            'MsgBox "Congratulation the data has been successfully Imported", vbInformation, "Data Imported"
            On Error GoTo 0

            'sales_form WILL BE CLOSED
            'Unload Me
            Exit Sub
    errHandler:
            'Clear memory
            Set rs = Nothing
            Set cnn = Nothing
            MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Import_Data"

    End Sub

我是Access VBA的新手,所以请在代码中添加其他注释。 我尝试使用UPDATE查询直接更新数据库,但是出现不允许更新错误。 经过大量的尝试和尝试,这部分似乎可以正常工作。 谢谢

0 个答案:

没有答案