none
How to overwrite data in Access using Excel VBA export code?

    Question

  • I'm trying to use VBA code in Excel to export data from my spreadsheet into an existing Access database.  The spreadsheet in question was set up by a co-worker, and I would prefer not to have to change anything but the background code.  The spreadsheet in question generates a primary key by using the date for each entry that is transferred into Access.  The spreadsheet has multiple end users, some of whom are, to put it kindly, not particularly computer savvy.

    The problem I'm running into is that some of the users are trying to export data for the same date and shift more than once.  Since the spreadsheet uses these to generate the primary key, when they attempt to export a second time the code errors out.

    My question, then, is this:

    Is there a way to set up my export such that it overwrites duplicated data?

    Thanks in advance for your help, folks.

    A sample of the export code:

    Sub DAOFromExcelToAccess_Changeover_Names()
    ' exports data from the active worksheet to a table in an Access database
    ' this procedure must be edited to your files before use
    ' when using this code in your file you will need to reference "Microsoft DAO 3.6 Object Library" located under "Tools" and "References..."
    Dim db As Database, rs As Recordset, r As Long
      Set db = OpenDatabase("J:\MX\Wire\Production\Cutter Report\Wire Production.mdb")
      ' open the database
      Set rs = db.OpenRecordset("Changeover Names", dbOpenTable)
      ' get all records in a table
      r = 23 ' the start row in the worksheet
      Do Until ActiveWorkbook.Sheets("Info").Range("U" & r).Value = ""
      ' repeat until first empty cell in column r >
        With rs
          .AddNew ' create a new record
          ' add values to each field in the record
          .Fields("Primary Key") = ActiveWorkbook.Sheets("Info").Range("U" & r).Value
          .Fields("Shift") = ActiveWorkbook.Sheets("Info").Range("V" & r).Value
          .Fields("Date") = ActiveWorkbook.Sheets("Info").Range("W" & r).Value
          .Fields("Record #") = ActiveWorkbook.Sheets("Info").Range("X" & r).Value
          .Fields("Machine") = ActiveWorkbook.Sheets("Info").Range("Y" & r).Value
          .Fields("1") = ActiveWorkbook.Sheets("Info").Range("Z" & r).Value
          .Fields("2") = ActiveWorkbook.Sheets("Info").Range("AA" & r).Value
          .Fields("3") = ActiveWorkbook.Sheets("Info").Range("AB" & r).Value
          .Fields("4") = ActiveWorkbook.Sheets("Info").Range("AC" & r).Value
          .Fields("5") = ActiveWorkbook.Sheets("Info").Range("AD" & r).Value
          .Fields("CT") = ActiveWorkbook.Sheets("Info").Range("AE" & r).Value
          .Fields("PO") = ActiveWorkbook.Sheets("Info").Range("AF" & r).Value
          .Fields("TP") = ActiveWorkbook.Sheets("Info").Range("AG" & r).Value
          .Fields("BP") = ActiveWorkbook.Sheets("Info").Range("AH" & r).Value
          .Fields("CC") = ActiveWorkbook.Sheets("Info").Range("AI" & r).Value
          .Fields("DI") = ActiveWorkbook.Sheets("Info").Range("AJ" & r).Value
          .Fields("CO") = ActiveWorkbook.Sheets("Info").Range("AK" & r).Value
          .Fields("Clean O") = ActiveWorkbook.Sheets("Info").Range("AL" & r).Value
          .Fields("EPI") = ActiveWorkbook.Sheets("Info").Range("AM" & r).Value
          .Fields("Change") = ActiveWorkbook.Sheets("Info").Range("AN" & r).Value
          .Fields("Other") = ActiveWorkbook.Sheets("Info").Range("AO" & r).Value
          ' add more fields if necessary...
          .Update ' stores the new record
        End With
        r = r + 1 ' next row
      Loop
      rs.Close
      Set rs = Nothing
      db.Close
      Set db = Nothing
    End Sub
    Wednesday, December 29, 2010 1:04 PM

Answers

  • I made some change sin the SSQL statement and now it works.  I tested it with a dummy database I created on my PC.

    Sub DAOFromExcelToAccess_Changeover_Names()
    ' exports data from the active worksheet to a table in an Access database
    ' this procedure must be edited to your files before use
    ' when using this code in your file you will need to reference "Microsoft DAO 3.6 Object Library" located under "Tools" and "References..."
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim r As Long
    Dim FName As String
    Dim ConnectionStr As String
     FName = "c:\temp\Test.mdb"
     'FName = "J:\MX\Wire\Production\Cutter Report\Wire Production.mdb"
     ConnectStr = _
     "Provider=Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & FName & ";" & _
     "Mode=Share Deny None;"
    
     cn.Open (ConnectStr)
     ' open the database
     
     ' get all records in a table
     r = 23 ' the start row in the worksheet
     Do Until ActiveWorkbook.Sheets("Info").Range("U" & r).Value = ""
     ' repeat until first empty cell in column r >
     'change from dbOpenTable to dbOpenDynamic
     With rs
       PrimaryKey = ActiveWorkbook.Sheets("Info").Range("U" & r).Value
     
       strSQL = "SELECT * " & _
        "FROM `Changeover Names`" & _
        "WHERE (`Changeover Names`.`Primay Key`='" & PrimaryKey & "')"
    
      .Open Source:=strSQL, _
       ActiveConnection:=cn, _
       CursorType:=adOpenDynamic, _
       LockType:=adLockOptimistic, _
       Options:=adCmdText
       
      'if EOF add new record otherwise overwrite old record
      If .EOF = True Then
       .AddNew ' create a new record
      End If
    
      ' add values to each field in the record
      .Fields("Primary Key") = PrimaryKey
      .Fields("Shift") = ActiveWorkbook.Sheets("Info").Range("V" & r).Value
      .Fields("Date") = ActiveWorkbook.Sheets("Info").Range("W" & r).Value
      .Fields("Record #") = ActiveWorkbook.Sheets("Info").Range("X" & r).Value
      .Fields("Machine") = ActiveWorkbook.Sheets("Info").Range("Y" & r).Value
      .Fields("1") = ActiveWorkbook.Sheets("Info").Range("Z" & r).Value
      .Fields("2") = ActiveWorkbook.Sheets("Info").Range("AA" & r).Value
      .Fields("3") = ActiveWorkbook.Sheets("Info").Range("AB" & r).Value
      .Fields("4") = ActiveWorkbook.Sheets("Info").Range("AC" & r).Value
      .Fields("5") = ActiveWorkbook.Sheets("Info").Range("AD" & r).Value
      .Fields("CT") = ActiveWorkbook.Sheets("Info").Range("AE" & r).Value
      .Fields("PO") = ActiveWorkbook.Sheets("Info").Range("AF" & r).Value
      .Fields("TP") = ActiveWorkbook.Sheets("Info").Range("AG" & r).Value
      .Fields("BP") = ActiveWorkbook.Sheets("Info").Range("AH" & r).Value
      .Fields("CC") = ActiveWorkbook.Sheets("Info").Range("AI" & r).Value
      .Fields("DI") = ActiveWorkbook.Sheets("Info").Range("AJ" & r).Value
      .Fields("CO") = ActiveWorkbook.Sheets("Info").Range("AK" & r).Value
      .Fields("Clean O") = ActiveWorkbook.Sheets("Info").Range("AL" & r).Value
      .Fields("EPI") = ActiveWorkbook.Sheets("Info").Range("AM" & r).Value
      .Fields("Change") = ActiveWorkbook.Sheets("Info").Range("AN" & r).Value
      .Fields("Other") = ActiveWorkbook.Sheets("Info").Range("AO" & r).Value
      ' add more fields if necessary...
      .Update ' stores the new record
     End With
     r = r + 1 ' next row
     Loop
     rs.Close
     Set rs = Nothing
     Db.Close
     Set Db = Nothing
    End Sub
    

    jdweng
    • Proposed as answer by Bruce Song Tuesday, January 04, 2011 7:03 AM
    • Marked as answer by Bruce Song Friday, January 07, 2011 9:05 AM
    Thursday, December 30, 2010 6:43 PM

All replies

  • the code below uses the ADO method so you need to add the reference "Microsoft ActiveX data Object 2.X library" to your VBA application.  Instead of Opening up a Table you need to open the Database is Dynamic Mode.  Then use a SQL statement to test if the record exists.  If the record doesn't exist then add the new record, otherwise over write the record found by the SQL Statement.

    Sub DAOFromExcelToAccess_Changeover_Names()
    ' exports data from the active worksheet to a table in an Access database
    ' this procedure must be edited to your files before use
    ' when using this code in your file you will need to reference "Microsoft DAO 3.6 Object Library" located under "Tools" and "References..."
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim r As Long
    Dim FName As String
    Dim ConnectionStr As String
     FName = "J:\MX\Wire\Production\Cutter Report\Wire Production.mdb"
     ConnectStr = _
      "Provider=Microsoft.Jet.OLEDB.4.0;" & _
      "Data Source=" & FName & ";" & _
      "Mode=Share Deny None;"
    
      cn.Open (ConnectStr)
     ' open the database
     
     ' get all records in a table
     r = 23 ' the start row in the worksheet
     Do Until ActiveWorkbook.Sheets("Info").Range("U" & r).Value = ""
     ' repeat until first empty cell in column r >
      'change from dbOpenTable to dbOpenDynamic
      With rs
       PrimaryKey = ActiveWorkbook.Sheets("Info").Range("U" & r).Value
       strSQL = "Select * from 'Changeover Names'" & _
         " where 'Changeover Names.Primary Key'='" & PrimaryKey & "'"
       
       .Open Source:=strSQL, _
         ActiveConnection:=cn, _
         CursorType:=adOpenDynamic, _
         LockType:=adLockOptimistic, _
         Options:=adCmdText
         
       'if EOF add new record otherwise overwrite old record
       If .EOF = True Then
         .AddNew ' create a new record
       End If
    
       ' add values to each field in the record
       .Fields("Primary Key") = PrimaryKey
       .Fields("Shift") = ActiveWorkbook.Sheets("Info").Range("V" & r).Value
       .Fields("Date") = ActiveWorkbook.Sheets("Info").Range("W" & r).Value
       .Fields("Record #") = ActiveWorkbook.Sheets("Info").Range("X" & r).Value
       .Fields("Machine") = ActiveWorkbook.Sheets("Info").Range("Y" & r).Value
       .Fields("1") = ActiveWorkbook.Sheets("Info").Range("Z" & r).Value
       .Fields("2") = ActiveWorkbook.Sheets("Info").Range("AA" & r).Value
       .Fields("3") = ActiveWorkbook.Sheets("Info").Range("AB" & r).Value
       .Fields("4") = ActiveWorkbook.Sheets("Info").Range("AC" & r).Value
       .Fields("5") = ActiveWorkbook.Sheets("Info").Range("AD" & r).Value
       .Fields("CT") = ActiveWorkbook.Sheets("Info").Range("AE" & r).Value
       .Fields("PO") = ActiveWorkbook.Sheets("Info").Range("AF" & r).Value
       .Fields("TP") = ActiveWorkbook.Sheets("Info").Range("AG" & r).Value
       .Fields("BP") = ActiveWorkbook.Sheets("Info").Range("AH" & r).Value
       .Fields("CC") = ActiveWorkbook.Sheets("Info").Range("AI" & r).Value
       .Fields("DI") = ActiveWorkbook.Sheets("Info").Range("AJ" & r).Value
       .Fields("CO") = ActiveWorkbook.Sheets("Info").Range("AK" & r).Value
       .Fields("Clean O") = ActiveWorkbook.Sheets("Info").Range("AL" & r).Value
       .Fields("EPI") = ActiveWorkbook.Sheets("Info").Range("AM" & r).Value
       .Fields("Change") = ActiveWorkbook.Sheets("Info").Range("AN" & r).Value
       .Fields("Other") = ActiveWorkbook.Sheets("Info").Range("AO" & r).Value
       ' add more fields if necessary...
       .Update ' stores the new record
      End With
      r = r + 1 ' next row
     Loop
     rs.Close
     Set rs = Nothing
     db.Close
     Set db = Nothing
    End Sub
    
    

    jdweng
    Wednesday, December 29, 2010 2:47 PM
  • I really appreciate the help!  I understand what you're trying to do, but I know next to nothing about SQL.  When I execute this code, the I get an error message which reads:

    Syntax error in query.  Incomplete query clause.

    The debug option takes me to the following lines of code:

      .Open Source:=strSQL, _
       ActiveConnection:=cn, _
       CursorType:=adOpenDynamic, _
       LockType:=adLockOptimistic, _
       Options:=adCmdText

    I'm using the ActiveX 2.8 library, if that has any bearing on the problem.

    Any thoughts?

    Thursday, December 30, 2010 3:16 PM
  • I made some change sin the SSQL statement and now it works.  I tested it with a dummy database I created on my PC.

    Sub DAOFromExcelToAccess_Changeover_Names()
    ' exports data from the active worksheet to a table in an Access database
    ' this procedure must be edited to your files before use
    ' when using this code in your file you will need to reference "Microsoft DAO 3.6 Object Library" located under "Tools" and "References..."
    Dim cn As New ADODB.Connection
    Dim rs As New ADODB.Recordset
    Dim r As Long
    Dim FName As String
    Dim ConnectionStr As String
     FName = "c:\temp\Test.mdb"
     'FName = "J:\MX\Wire\Production\Cutter Report\Wire Production.mdb"
     ConnectStr = _
     "Provider=Microsoft.Jet.OLEDB.4.0;" & _
     "Data Source=" & FName & ";" & _
     "Mode=Share Deny None;"
    
     cn.Open (ConnectStr)
     ' open the database
     
     ' get all records in a table
     r = 23 ' the start row in the worksheet
     Do Until ActiveWorkbook.Sheets("Info").Range("U" & r).Value = ""
     ' repeat until first empty cell in column r >
     'change from dbOpenTable to dbOpenDynamic
     With rs
       PrimaryKey = ActiveWorkbook.Sheets("Info").Range("U" & r).Value
     
       strSQL = "SELECT * " & _
        "FROM `Changeover Names`" & _
        "WHERE (`Changeover Names`.`Primay Key`='" & PrimaryKey & "')"
    
      .Open Source:=strSQL, _
       ActiveConnection:=cn, _
       CursorType:=adOpenDynamic, _
       LockType:=adLockOptimistic, _
       Options:=adCmdText
       
      'if EOF add new record otherwise overwrite old record
      If .EOF = True Then
       .AddNew ' create a new record
      End If
    
      ' add values to each field in the record
      .Fields("Primary Key") = PrimaryKey
      .Fields("Shift") = ActiveWorkbook.Sheets("Info").Range("V" & r).Value
      .Fields("Date") = ActiveWorkbook.Sheets("Info").Range("W" & r).Value
      .Fields("Record #") = ActiveWorkbook.Sheets("Info").Range("X" & r).Value
      .Fields("Machine") = ActiveWorkbook.Sheets("Info").Range("Y" & r).Value
      .Fields("1") = ActiveWorkbook.Sheets("Info").Range("Z" & r).Value
      .Fields("2") = ActiveWorkbook.Sheets("Info").Range("AA" & r).Value
      .Fields("3") = ActiveWorkbook.Sheets("Info").Range("AB" & r).Value
      .Fields("4") = ActiveWorkbook.Sheets("Info").Range("AC" & r).Value
      .Fields("5") = ActiveWorkbook.Sheets("Info").Range("AD" & r).Value
      .Fields("CT") = ActiveWorkbook.Sheets("Info").Range("AE" & r).Value
      .Fields("PO") = ActiveWorkbook.Sheets("Info").Range("AF" & r).Value
      .Fields("TP") = ActiveWorkbook.Sheets("Info").Range("AG" & r).Value
      .Fields("BP") = ActiveWorkbook.Sheets("Info").Range("AH" & r).Value
      .Fields("CC") = ActiveWorkbook.Sheets("Info").Range("AI" & r).Value
      .Fields("DI") = ActiveWorkbook.Sheets("Info").Range("AJ" & r).Value
      .Fields("CO") = ActiveWorkbook.Sheets("Info").Range("AK" & r).Value
      .Fields("Clean O") = ActiveWorkbook.Sheets("Info").Range("AL" & r).Value
      .Fields("EPI") = ActiveWorkbook.Sheets("Info").Range("AM" & r).Value
      .Fields("Change") = ActiveWorkbook.Sheets("Info").Range("AN" & r).Value
      .Fields("Other") = ActiveWorkbook.Sheets("Info").Range("AO" & r).Value
      ' add more fields if necessary...
      .Update ' stores the new record
     End With
     r = r + 1 ' next row
     Loop
     rs.Close
     Set rs = Nothing
     Db.Close
     Set Db = Nothing
    End Sub
    

    jdweng
    • Proposed as answer by Bruce Song Tuesday, January 04, 2011 7:03 AM
    • Marked as answer by Bruce Song Friday, January 07, 2011 9:05 AM
    Thursday, December 30, 2010 6:43 PM