Export from Excel to Access Using VBA

Collapse
X
 
  • Time
  • Show
Clear All
new posts
  • jason1286
    New Member
    • Dec 2011
    • 1

    Export from Excel to Access Using VBA

    I currently have code that exports from Excel to Access to add to the bottom of the table. However, if my data in Excel has a primary key that already exists in the Access table it causes an error since you cannot have 2 of the same primary key in a table. Does anyone know what I can add to my code so that if the primary key exists in the table already it will just update with the most recently exported informatiom from Excel, and still keep my same code of adding to the bottom of the table if the primary key does not exisit? I do not have a good understanding of VBA and this is my first attempt at trying to create code. I hope someone can help! Thanks!

    Code:
    Sub CommandButton1_Click()
    
    Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
        ' connect to the Access database
        Set cn = New ADODB.Connection
        cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; " & _
            "Data Source=C:\Test\Test.accdb;"
        ' open a recordset
        Set rs = New ADODB.Recordset
        rs.Open "TestExcelMacroExport", cn, adOpenKeyset, adLockOptimistic, adCmdTable
        ' all records in a table
        r = 2 ' the start row in the worksheet
        Do Until ActiveWorkbook.Sheets("Data").Range("A" & r).Value = ""
        ' repeat until first empty cell in column A
            With rs
                PrimaryKey = ActiveWorkbook.Sheets("Data").Range("A" & r).Value
                .AddNew ' create a new record
                ' add values to each field in the record
                .Fields("GroupID") = PrimaryKey
                .Fields("EffectiveDate") = Range("B" & r).Value
                .Fields("ClaimsPMPM") = Range("C" & r).Value
                .Fields("Contracts") = Range("D" & r).Value
                .Fields("Members") = Range("E" & r).Value
                .Fields("OrigPremPMPM") = Range("F" & r).Value
                .Fields("FinalPremPMPM") = Range("G" & r).Value
                .Fields("PlanName") = Range("H" & 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
        cn.Close
        Set cn = Nothing
    End Sub
    Last edited by Stewart Ross; Dec 1 '11, 07:11 PM. Reason: added code tags to code segment
Working...