Hello all,
I have some code that I am using to upload info from Excel to Access (see bellow). The code goes line by line and checks to see if the data is in the database. If it is it will update the fields, if not it will add a new line in the database.
The problem I am running into is that as the database gets larger the code takes longer and longer to run. Looking through the forums i found some code by ahmed_one (see bellow) that treats the data like an array and uploads it with a sql statement. It however only adds data and does not update data if a duplicate is found.
I was curious if any of you out there might have a a way to to do this, im not very familiar with sql, with ahmed_ones code or if there is a way to fix my code to make it faster?
Thanks in advance for your help!
-Shorn
Code im using at the moment
ahmed_one's Code
I have some code that I am using to upload info from Excel to Access (see bellow). The code goes line by line and checks to see if the data is in the database. If it is it will update the fields, if not it will add a new line in the database.
The problem I am running into is that as the database gets larger the code takes longer and longer to run. Looking through the forums i found some code by ahmed_one (see bellow) that treats the data like an array and uploads it with a sql statement. It however only adds data and does not update data if a duplicate is found.
I was curious if any of you out there might have a a way to to do this, im not very familiar with sql, with ahmed_ones code or if there is a way to fix my code to make it faster?
Thanks in advance for your help!
-Shorn
Code im using at the moment
Code:
Public Sub UpdateDatabase()
Dim cn As ADODB.Connection, rs As ADODB.Recordset
Dim sOrderdate As String, sRegion As String, sRep As String, sItem As String, sUnits As String
Dim sUnitcost As String, sTotal As String
Dim sWSName As String
If Application.Caller = "Upload Data" Then
sWSName = "Upload"
End If
'' connect to the Access database
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
ThisWorkbook.Path & "\datatest.accdb;"
' open a recordset
Set rs = New ADODB.Recordset
rs.Open "DataTest", cn, adOpenKeyset, adLockOptimistic, adCmdTable
Application.ScreenUpdating = False
Worksheets(sWSName).Activate
Range("A15").Activate '' row 1 contains column headings
Do While Not IsEmpty(ActiveCell)
sOrderdate = ActiveCell.Value
sRegion = ActiveCell.Offset(0, 1).Value
sRep = ActiveCell.Offset(0, 2).Value
sItem = ActiveCell.Offset(0, 3).Value
sUnits = ActiveCell.Offset(0, 4).Value
sUnitcost = ActiveCell.Offset(0, 5).Value
sTotal = ActiveCell.Offset(0, 6).Value
rs.Filter = "OrderDate='" & sOrderdate & "' AND Region='" & sRegion & "'"
If rs.EOF Then
Debug.Print "No existing record - adding new..."
rs.Filter = ""
rs.AddNew
rs("OrderDate").Value = sOrderdate
rs("Region").Value = sRegion
rs("Rep").Value = sRep
rs("Item").Value = sItem
rs("Units").Value = sUnits
rs("UnitCost").Value = sUnitcost
rs("Total").Value = sTotal
Else
Debug.Print "Existing record found..."
End If
rs("Rep").Value = sRep
rs("Item").Value = sItem
rs("Units").Value = sUnits
rs("UnitCost").Value = sUnitcost
rs("Total").Value = sTotal
rs.Update
Debug.Print "...record update complete."
ActiveCell.Offset(1, 0).Activate '' next cell down
On Error GoTo dbError
i = i + 1
Loop
dbError:
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
Application.ScreenUpdating = True
'ThisWorkbook.Save
MsgBox (aPage & " has been added to the database")
End Sub
ahmed_one's Code
Code:
Public Sub DoTrans()
Set cn = CreateObject("ADODB.Connection")
dbPath = Application.ActiveWorkbook.Path & "\Datatest.accdb"
dbWb = Application.ActiveWorkbook.FullName
dbWs = Application.ActiveSheet.Name
scn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
dsh = "[" & Application.ActiveSheet.Name & "$]"
cn.Open scn
ssql = "INSERT INTO DataTest ([fdName], [fdOne], [fdTwo]) "
ssql = ssql & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh
cn.Execute ssql
End Sub