Backup and recover physical and cloud-based servers and workstations, as well as endpoint devices that belong to remote users. Avoid downtime and data loss quickly and easily for Windows-based physical or public cloud-based workloads!
Sub applydescriptionstoproducts() Dim cnn As ADODB.Connection Set cnn = New ADODB.Connection cnn.ConnectionString = strcnn cnn.Open CurrentProject.Connection 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 Debug.Print productid 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] deeprodrs.MoveNext Loop deeprodrs.Close 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 proddesrs.MoveNext Loop proddesrs.Close prodrs.MoveNext Loop Rem all done close recordsets prodrs.Close Set prodrs = Nothing Set deeprodrs = Nothing Set proddesrs = Nothing Rem close the database connection cnn.Close Set cnn = Nothing Exit Sub emptystringerror: Resume Next Exit Sub End Sub
Add your voice to the tech community where 5M+ people just like you are talking about what matters.
Join the community of 500,000 technology professionals and ask your questions.