S
Secret Squirrel
I have the following code set up to export data from excel to an access
table. How do I add code to delete all the data in the table before the
export? I want to be able to delete all the data in the table so that the
data is not duplicated. This will allow the users to export multiple times
without duplicating records. ( in case they hit the run button more than once
or need to change data after they've exported once).
Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; " & _
"DBQ=C:\Documents and Settings\My Documents\Work Databases\BC Quality
Action Database.mdb;SystemDB=C:\Documents and Settings\My Documents\Work
Databases\sys.mdw;" & _
"Uid=admin;" & _
"Pwd=password;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "0106EXT", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 6 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("RMA") = Range("A" & r).Value
.Fields("DateNotified") = Range("B" & r).Value
.Fields("DateDispositionMade") = Range("C" & r).Value
.Fields("Branch") = Range("D" & r).Value
.Fields("WO#") = Range("E" & r).Value
.Fields("Customer") = Range("F" & r).Value
.Fields("PO#") = Range("G" & r).Value
.Fields("CustomerPN") = Range("H" & r).Value
.Fields("Qty") = Range("I" & r).Value
.Fields("UnitofMeasure") = Range("J" & r).Value
.Fields("Operator") = Range("K" & r).Value
.Fields("DiscCode") = Range("L" & r).Value
.Fields("DiscrepancyDescription") = Range("M" & r).Value
.Fields("DispCode") = Range("N" & r).Value
.Fields("TotalCost") = Range("O" & r).Value
.Fields("IncCode") = Range("P" & r).Value
.Fields("CostofInc") = Range("Q" & r).Value
.Fields("QRCost") = Range("R" & r).Value
.Fields("RewCost") = Range("S" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
MsgBox "Data has been uploaded to 0106Ext"
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub
table. How do I add code to delete all the data in the table before the
export? I want to be able to delete all the data in the table so that the
data is not duplicated. This will allow the users to export multiple times
without duplicating records. ( in case they hit the run button more than once
or need to change data after they've exported once).
Sub ADOFromExcelToAccess()
' exports data from the active worksheet to a table in an Access database
' this procedure must be edited before use
Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "DRIVER={Microsoft Access Driver (*.mdb)}; " & _
"DBQ=C:\Documents and Settings\My Documents\Work Databases\BC Quality
Action Database.mdb;SystemDB=C:\Documents and Settings\My Documents\Work
Databases\sys.mdw;" & _
"Uid=admin;" & _
"Pwd=password;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "0106EXT", cn, adOpenKeyset, adLockOptimistic, adCmdTable
' all records in a table
r = 6 ' the start row in the worksheet
Do While Len(Range("A" & r).Formula) > 0
' repeat until first empty cell in column A
With rs
.AddNew ' create a new record
' add values to each field in the record
.Fields("RMA") = Range("A" & r).Value
.Fields("DateNotified") = Range("B" & r).Value
.Fields("DateDispositionMade") = Range("C" & r).Value
.Fields("Branch") = Range("D" & r).Value
.Fields("WO#") = Range("E" & r).Value
.Fields("Customer") = Range("F" & r).Value
.Fields("PO#") = Range("G" & r).Value
.Fields("CustomerPN") = Range("H" & r).Value
.Fields("Qty") = Range("I" & r).Value
.Fields("UnitofMeasure") = Range("J" & r).Value
.Fields("Operator") = Range("K" & r).Value
.Fields("DiscCode") = Range("L" & r).Value
.Fields("DiscrepancyDescription") = Range("M" & r).Value
.Fields("DispCode") = Range("N" & r).Value
.Fields("TotalCost") = Range("O" & r).Value
.Fields("IncCode") = Range("P" & r).Value
.Fields("CostofInc") = Range("Q" & r).Value
.Fields("QRCost") = Range("R" & r).Value
.Fields("RewCost") = Range("S" & r).Value
' add more fields if necessary...
.Update ' stores the new record
End With
r = r + 1 ' next row
Loop
MsgBox "Data has been uploaded to 0106Ext"
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
End Sub