[Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1365
  • Last Modified:

Update table using vba recordset

I am creating a string that pulls data from another table that lists all the available sizes for a product, which will be written to a field in my products table, using an update query. I have code to update this field for a particular product that works, but I would like this to happen for each record in the products table, so i am trying to use a recordset instead, with little success. Below is the code that works for a single product (SMSTY).

How could I change this to do it for each record (product)? I have the following:
Public Sub Updatesizes()
Dim db As Database
Set db = CurrentDb
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("tbl_Product")

rs.MoveFirst
Do While Not rs.EOF Or rs.BOF
rs.Edit
        If rs!str_ProductClass = "A" Then
        MsgBox ("yes")
            If DLookup("SMV02", "ABS400F_MSTSTYLM", "SMSTY = Forms!ParametersForm!str_SMSTY") <> "G" Then
            Else
            Dim strsql As String
            strsql = "XS,"
            End If
            Debug.Print strsql
           
            If DLookup("SMV03", "ABS400F_MSTSTYLM", "SMSTY = Forms!ParametersForm!str_SMSTY") <> "G" Then
            Else
            strsql = strsql & "S,"
            End If
...
        Dim strsql2 As String
            strsql2 = "UPDATE tbl_Product SET tbl_Product.str_AvailableSizes =" & """" & strsql & """"
            strsql2 = strsql2 & " WHERE str_SMSTY = Forms!ParametersForm!str_SMSTY"
            DoCmd.RunSQL (strsql2)
        Debug.Print strsql2
    Else
    Exit Sub
        rs.MoveNext
       End If
    Loop
End Sub

Thanks
If DLookup("SMV02", "ABS400F_MSTSTYLM", "SMSTY = Forms!ParametersForm!str_SMSTY") <> "G" Then
Else
Dim strsql As String
strsql = "XS,"
End If
 
If DLookup("SMV03", "ABS400F_MSTSTYLM", "SMSTY = Forms!ParametersForm!str_SMSTY") <> "G" Then
Else
strsql = strsql & "S,"
End If
 
If DLookup("SMV04", "ABS400F_MSTSTYLM", "SMSTY = Forms!ParametersForm!str_SMSTY") <> "G" Then
Else
strsql = strsql & "M,"
End If
 
If DLookup("SMV05", "ABS400F_MSTSTYLM", "SMSTY = Forms!ParametersForm!str_SMSTY") <> "G" Then
Else
strsql = strsql & "L,"
End If
 
If DLookup("SMV06", "ABS400F_MSTSTYLM", "SMSTY = Forms!ParametersForm!str_SMSTY") <> "G" Then
 
Else
strsql = strsql & "XL,"
End If
 
If DLookup("SMV07", "ABS400F_MSTSTYLM", "SMSTY = Forms!ParametersForm!str_SMSTY") <> "G" Then
Else
strsql = strsql & "2XL,"
End If
 
If DLookup("SMV08", "ABS400F_MSTSTYLM", "SMSTY = Forms!ParametersForm!str_SMSTY") <> "G" Then
Else
strsql = strsql & "3XL,"
End If
 
If DLookup("SMV09", "ABS400F_MSTSTYLM", "SMSTY = Forms!ParametersForm!str_SMSTY") <> "G" Then
Else
strsql = strsql & "4XL,"
End If
 
If DLookup("SMV10", "ABS400F_MSTSTYLM", "SMSTY = Forms!ParametersForm!str_SMSTY") <> "G" Then
Else
strsql = strsql & "5XL,"
End If
 
 
If DLookup("SMV11", "ABS400F_MSTSTYLM", "SMSTY = Forms!ParametersForm!str_SMSTY") <> "G" Then
Else
strsql = strsql & "6XL,"
End If
 
If DLookup("SMV12", "ABS400F_MSTSTYLM", "SMSTY = Forms!ParametersForm!str_SMSTY") <> "G" Then
Else
strsql = strsql & "and up"
End If
 
    If IsNull(DLookup("str_AvailableSizes", "tbl_Product", "str_SMSTY = Forms!ParametersForm!str_SMSTY")) Then
    
        Dim strsql2 As String
            strsql2 = "UPDATE tbl_Product SET tbl_Product.str_AvailableSizes =" & """" & strsql & """"
            strsql2 = strsql2 & " WHERE str_SMSTY = Forms!ParametersForm!str_SMSTY"
            DoCmd.RunSQL (strsql2)
    
    Else
        Exit Sub
    End If

Open in new window

0
lericks3
Asked:
lericks3
  • 3
1 Solution
 
peter57rCommented:
What values do smvo2 ...smv12 contain (apart from G)?
0
 
prachwalCommented:
Dim strsql As String
If not DLookup("SMV02", "ABS400F_MSTSTYLM", "SMSTY = Forms!ParametersForm!str_SMSTY") <> "G" Then
strsql = "XS,"
End If

that's bather ;)
0
 
peter57rCommented:
"What values do smvo2 ...smv12 contain (apart from G)?"
What I really want to know is whether they contain the size letters or some other values.
0
 
lericks3Author Commented:
smv02-smv12 only have a G if they have the corresponding available size, otherwise they are null. (example: smv03 is "G" if that product comes in a small, smv04 is "G" if that product comes in a medium, etc.) The string works fine - what i put in the code snippet box is working but only creates the string and then updates that field for ONE product, but I need to find a way to update ALL products in this way, which is why I am trying out the recordset, which doesn't work.
0
 
peter57rCommented:
Since you named field in a convenient style I would do this a different way using 2 recordsets and avoiding all of the dlookups, which are quite slow in operation.
(Untested code)

Public Sub Updatesizes()
Dim db As Database
Dim rs As DAO.Recordset
Dim rsz As DAO.Recordset
Dim allsizes() As String
Dim sizes As String
Dim x
allsizes = Split(",,XS,S,M,L,XL,2XL,3XL,4XL,5XL,6XL,and up", ",")


Set db = CurrentDb
Set rs = CurrentDb.OpenRecordset("tbl_Product")

rs.MoveFirst
Do While Not rs.EOF Or rs.BOF

    If rs!str_ProductClass = "A" Then
        'get the matching sizes record
            Set rsz = db.OpenRecordset("Select * from ABS400F_MSTSTYLM where SMSTY =" & Forms!ParametersForm!str_SMSTY)
            For x = 2 To 12
                If rsz.Fields("SMV" & Format(x, "00")) = "G" Then
                    sizes = sizes & allsizes(x) & ","
                Else
                ' do nothing
                End If
            Next x
            ' remove final comma
            If Len(sizes) > 0 Then sizes = Left(sizes, Len(sizes) - 1)
           
          ' update the products record
            rs.Edit
            rs!str_AvailableSizes = sizes
            rs.Update
           
    Else
    ' do nothing
    End If
    rs.MoveNext
Loop

rsz.Close
Set rsz = Nothing
rs.Close
Set rs = Nothing
Set db = Nothing


End Sub
0

Featured Post

Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now