I am trying to link data from three different sources into one single database and all was going well but all of a sudden I have hit a brick wall. The current updates I am running to merge the latest set of data just seem to be running so slow. I could really do with some advice on how to optimise this section of code as we have 11,700 records to update and it is painful. Like I said I am not an expert - just starting out with access so am sure I could be doing things better.
Dim cnn As ADODB.Connection
Set cnn = New ADODB.Connection
cnn.ConnectionString = strcnn
Dim strprodcode As String
Dim strDescription As String
Dim strSummary As String
Dim strName As String
Dim prodrs As ADODB.Recordset
Dim deeprodrs As ADODB.Recordset
Dim proddesrs As ADODB.Recordset
Dim productid As Integer
Set prodrs = New ADODB.Recordset
prodrs.ActiveConnection = CurrentProject.Connection
prodrs.Source = "vgm_products"
prodrs.CursorType = adOpenDynamic
prodrs.LockType = adLockOptimistic
Set deeprodrs = New ADODB.Recordset
deeprodrs.ActiveConnection = CurrentProject.Connection
deeprodrs.Source = "products"
deeprodrs.CursorType = adOpenDynamic
deeprodrs.LockType = adLockOptimistic
Set proddesrs = New ADODB.Recordset
proddesrs.ActiveConnection = CurrentProject.Connection
proddesrs.Source = "vgm_product_desc"
proddesrs.CursorType = adOpenDynamic
proddesrs.LockType = adLockOptimistic
prodrs.Open "SELECT vgm_products.[code],vgm_products.[product_id] FROM vgm_products "
Do Until prodrs.EOF
strDescription = " "
strSummary = " "
strName = " "
strprodcode = prodrs!code
productid = prodrs!product_id
deeprodrs.Open "SELECT products.[short_desc],products.[name],products.[description] FROM products WHERE (((products.[ProductStyle])= " & Chr(34) & strprodcode & Chr(34) & "));"
Do Until deeprodrs.EOF
Rem there are blanks in this column so we need to ignore this error
Rem that is caused by assigning null to a string
On Error GoTo emptystringerror:
strDescription = deeprodrs!Description
strSummary = deeprodrs![short_desc]
strName = deeprodrs![Name]
proddesrs.Open "SELECT * FROM vgm_product_desc WHERE (((vgm_product_desc.[product_id])= " & productid & "));"
Rem if we found it save the id
Do Until proddesrs.EOF
proddesrs![Description] = strDescription
proddesrs![summary] = strSummary
proddesrs![Name] = strName
Rem all done close recordsets
Set prodrs = Nothing
Set deeprodrs = Nothing
Set proddesrs = Nothing
Rem close the database connection
Set cnn = Nothing