简体   繁体   中英

How to export message box display data in excel to access database table using vba

I have a code in vba through which whenever i will save any new value in a particular cell it will show in the message box that what was the old value stored in the cell and what was the new value which i have just saved below is the code for that

Option Explicit

Dim OldVals As New Dictionary

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim myCell As Range

    For Each myCell In Target
        If OldVals.Exists(myCell.Address) Then
           MsgBox "New value of " & Replace(myCell.Address, "$", "") & " is " & myCell.Value & "; old value was " & OldVals(myCell.Address)
        Else
           MsgBox "No old value for " + Replace(myCell.Address, "$", "")
        End If
        OldVals(myCell.Address) = myCell.Value
    Next myCell

End Sub

the output window of the code will come like this in the picture below -- 在此处输入图片说明

so i want to export the values which was displayed in the message box to the access database table using vba one after the another

however i have written a code to export and save the values of excel sheet cells into access database table the code is below

Const TARGET_DB = "\Database3.accdb"
    Sub PushTableToAccess()
    Dim cnn As ADODB.Connection
    Dim MyConn
    Dim rst As ADODB.Recordset
    Dim i As Long, j As Long
    Dim Rw As Long

    Sheets("Sheet1").Activate
    Rw = Range("A1").End(xlDown).Row

    Set cnn = New ADODB.Connection
    MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB

    With cnn
    .Provider = "Microsoft.ACE.OLEDB.12.0"
    .Open MyConn
    End With



    Set rst = New ADODB.Recordset
    rst.CursorLocation = adUseServer
    rst.Open Source:="Table1", ActiveConnection:=cnn, _
    CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
    Options:=adCmdTable

    For i = 2 To Rw
        rst.AddNew
        For j = 1 To 3
            rst(j) = Cells(i, j).Value
        Next j
        rst.Update
    Next i


    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing

    End Sub

the above code will export and save all the values in excel cells to access database table .

but i am not sure how to combine both the codes so that my first code whenever it will display the old and new values of cell and when i click on OK button it will export and save the value displayed in message box (eg- new value of A1 is 7 ; old value was 88) to access database table one after the another .

It seems you want to make an audit/logging function of all changes to a an Excel workbook.

You have two pieces of code, one to identify the change and one to write information to a datbase, an you want to combine this. The resulting functionality wold then be to write every change the user makes to a database.

The code you have should give you enough guidance on the particular VBA statements. I'll limit this solution to the approach.

As you will need the database connection during the whole time the user has the worksheet opened, you should make the database connection in the Workbook Open event:

Public cnn As ADODB.Connection
Public MyConn

Private Sub Workbook_Open()
    Set cnn = New ADODB.Connection
    MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
    With cnn
        .Provider = "Microsoft.ACE.OLEDB.12.0"
        .Open MyConn
    End With
End Sub

Then you continue in the Change events:

Private Sub Worksheet_Change(ByVal Target As Range)

    '.... (your code to get the change)

    Set rst = New ADODB.Recordset

    rst.AddNew                     ' allocate new record
    rst(j) = Cells(i, j).Value     ' populate the record (this must be your code)
    rst.Update                     ' update/insert record
    rst.Close                      ' done record.
End Sub

Finally you close the database in the Workbook_BeforeClose event.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM