Loop through recordset not recognizing .MoveNext?

T

The Archn00b

Registered User.
Local time
Today, 14:05
Joined
Jun 26, 2013
Messages
76
Hello,

So I have a table "zztblArticles." Some fields should go to "tblArticles" and values in Tag_ID should go to a lookup table "tblTag" and a junction table "tblArticles_Tags." I'll explain the code I've written below:


Code: 
Private Sub cmdSubmit_Click()
    
    Dim db As Database
    Dim strINSERT As String
    Dim strVALUES As String
    Dim rszztblArticles As DAO.Recordset
    
    Set db = CurrentDb
    Set rszztblArticles = db.OpenRecordset("SELECT zztblArticles.Publishing_Date, zztblArticles.Title" & _
        ", zztblArticles.Source_ID, zztblArticles.Sourcer_ID, zztblArticles.Sourcing_Date" & _
        ", zztblArticles.Source_Category_ID, zztblArticles.Location, zztblArticles.Comments, zztblArticles.Tag_ID FROM zztblArticles;")
        
    strINSERT = "INSERT INTO tblArticles (Publishing_Date, Title, Location, Sourcing_Date, Comments "
    strVAlUES = " VALUES ('" & DateDiff("d", #5/16/2014#, rszztblArticles!Publishing_Date) & _
        "', '" & rszztblArticles!Title & "', '" & rszztblArticles!Location & _
        "', '" & rszztblArticles!Sourcing_Date & "', '" & rszztblArticles!Comments & "'"

    With rszztblArticles
    
    .MoveFirst
    
    Do While .EOF = False
            
            'Creates sql to append to single-value fields from zztblArticles to tblArticles
            If IsNull(!Source_ID) = False Then
            strINSERT = strINSERT & ", Source_ID"
            strVAlUES = strVAlUES & ", '" & !Source_ID & "'"
            End If
            
            If IsNull(!Sourcer_ID) = False Then
            strINSERT = strINSERT & ", Sourcer_ID"
            strVAlUES = strVAlUES & ", '" & !Sourcer_ID & "'"
            End If
            
            If IsNull(!Source_Category_ID) = False Then
            strINSERT = strINSERT & ", Source_Category_ID"
            strVAlUES = strVAlUES & ", '" & !Source_Category_ID & "'"
            End If
            
            'Appends single-value fields to tblArticles
            db.Execute (strINSERT & ")" & strVALUES & ")")
            
            'Finds the automatically generated ID in tblArticles by matching Sourcing_Date
            intArticleID = DLookup("ID", "tblArticles", "Sourcing_Date = " & !Sourcing_Date)
            
'Creates an array from the Tag ID value which could be (England, Scotland, Wales)
            TagsArray = Split(!Tag_ID, ",", , vbTextCompare)
            
            Dim i As Integer
'For each item in the Array            
            For i = LBound(TagsArray) To UBound(TagsArray)
                If IsNull(DLookup("Tag", "tblTag", "tblTag.Tag = '" & Trim(TagsArray(i)) & "'")) Then
                db.Execute ("INSERT INTO tblTag (Tag) VALUES ('" & Trim(TagsArray(i)) & "')")
                End If
                intTagID = DLookup("ID", "tblTag", "tblTag.Tag = '" & Trim(TagsArray(i)) & "'")
                db.Execute ("INSERT INTO tblArticles_Tags (Tag_ID, Article_ID) VALUES (" & intTagID & "," & intArticleID & ")")
            Next i
            
            db.Execute ("DELETE * FROM zztblArticles WHERE Sourcing_Date = " & rszztblArticles!Sourcing_Date)
        .MoveNext
    
    Loop
    
    .Close
    
    End With
    
    Set db = Nothing
    db.Close
    MsgBox ("Your articles have been uploaded successfully")
    
    Exit Sub
            
End Sub

The first loop through works fine, I get the records uploaded to all tables. The second loop through fails at

Code: 
intArticleID = DLookup("ID", "tblArticles", "Sourcing_Date = " & !Sourcing_Date)

Because it can't decide which ID value to use. This is because the value has been duplicated in tblArticles after the code acts on the same record again. It has completely failed to move to the next record in the recordset, despite the .MoveNext before the Loop!

Any ideas?

Thanks!
 
Is there anything I can make clearer? I know it's a quite a long question.
 
Quick thought: have you tried using the date delimiter when using dates as criteria? (And brackets around that awkward underscoring in the field name...!!)

Code: 
intArticleID = DLookup("ID", "tblArticles", "[Sourcing_Date] = #" & ![Sourcing_Date] & "#")
 
Mile-O said:
Quick thought: have you tried using the date delimiter when using dates as criteria? (And brackets around that awkward underscoring in the field name...!!)

Code: 
intArticleID = DLookup("ID", "tblArticles", "[Sourcing_Date] = #" & ![Sourcing_Date] & "#")
Click to expand...

The field Sourcing_Date is actually stored as a number and recalculated into a date using Date_Add on demand. This line of code actually seems to work on the first loop through, but then fails on the second loop, because the recordset hasn't moved to the next record (.movenext not working for some reason). The Sourcing_Date value is then appended AGAIN and so the code can't find the unique value of Sourcing_Date in tblArticles.
 
I would suggest that you step through the code to see what is happening and what is not.
 
Last edited:
if you get a rte, the process will break before processing the .movenext

however, is it possible that the delete has the effect of deleting the records in the recordset, so the .movenext causes .eof to be true, and therefore the block terminates normally?
 
All the suggestions made (from Mile-O, Rain and gemma-the-husky) are valid:

1. Step through your code
2. Format your date parameters
3. The Delete execution is probably deleting more records than is necessary or deleting the wrong record. Or the date format (point 2) you're passing to the DLookup can't find a related date. You're in a bit of a recursive loop.

Why don't you do all of this in different queries? We would need to see some data to fully understand what you're trying to accomplish.
 
The Archn00b said:
What's an rte?
Click to expand...

An RTE is something that makes people look smarter. Groovy talk.

When I went to school I learnt that communication is only good when both parties understand, and to take it further, when each party understands that the other parties understand.

I hope you understand.
 
rte is a run time error.

ie something goes wrong before it gets to the .movement statement.
 
RainLover said:
An RTE is something that makes people look smarter. Groovy talk.

When I went to school I learnt that communication is only good when both parties understand, and to take it further, when each party understands that the other parties understand.

I hope you understand.
Click to expand...

uwotm8 :D

rte is a run time error.

ie something goes wrong before it gets to the .movement statement.
Click to expand...

Ah thanks
 
Sup fellas. Found the solution after going through it step by step. The dimension "strVALUES" should have been inside the Do/Loop. It wasn't subject to MoveNext and therefore stayed on the same record!

Code: 
Private Sub cmdSubmit_Click()
    
    Dim db As Database
    Dim strINSERT As String
    Dim strVALUES As String
    Dim rszztblArticles As DAO.Recordset
    
    Set db = CurrentDb
    Set rszztblArticles = db.OpenRecordset("SELECT zztblArticles.Publishing_Date, zztblArticles.Title" & _
        ", zztblArticles.Source_ID, zztblArticles.Sourcer_ID, zztblArticles.Sourcing_Date" & _
        ", zztblArticles.Source_Category_ID, zztblArticles.Location, zztblArticles.Comments, zztblArticles.Tag_ID FROM zztblArticles;")
        
    strINSERT = "INSERT INTO tblArticles (Publishing_Date, Title, Location, Sourcing_Date, Comments "
    
    With rszztblArticles
    
    Do While .EOF = False
            
            'Creates sql to append to single-value fields from zztblArticles to tblArticles

strVALUES = " VALUES ('" & DateDiff("d", #5/16/2014#, rszztblArticles!Publishing_Date) & _
        "', '" & rszztblArticles!Title & "', '" & rszztblArticles!Location & _
        "', '" & rszztblArticles!Sourcing_Date & "', '" & rszztblArticles!Comments & "'"
            If IsNull(!Source_ID) = False Then
            strINSERT = strINSERT & ", Source_ID"
            strVAlUES = strVAlUES & ", '" & !Source_ID & "'"
            End If
            
            If IsNull(!Sourcer_ID) = False Then
            strINSERT = strINSERT & ", Sourcer_ID"
            strVAlUES = strVAlUES & ", '" & !Sourcer_ID & "'"
            End If
            
            If IsNull(!Source_Category_ID) = False Then
            strINSERT = strINSERT & ", Source_Category_ID"
            strVAlUES = strVAlUES & ", '" & !Source_Category_ID & "'"
            End If
            
            'Appends single-value fields to tblArticles
            db.Execute (strINSERT & ")" & strVALUES & ")")
            
            'Finds the automatically generated ID in tblArticles by matching Sourcing_Date
            intArticleID = DLookup("ID", "tblArticles", "Sourcing_Date = " & !Sourcing_Date)
            
'Creates an array from the Tag ID value which could be (England, Scotland, Wales)
            TagsArray = Split(!Tag_ID, ",", , vbTextCompare)
            
            Dim i As Integer
'For each item in the Array            
            For i = LBound(TagsArray) To UBound(TagsArray)
                If IsNull(DLookup("Tag", "tblTag", "tblTag.Tag = '" & Trim(TagsArray(i)) & "'")) Then
                db.Execute ("INSERT INTO tblTag (Tag) VALUES ('" & Trim(TagsArray(i)) & "')")
                End If
                intTagID = DLookup("ID", "tblTag", "tblTag.Tag = '" & Trim(TagsArray(i)) & "'")
                db.Execute ("INSERT INTO tblArticles_Tags (Tag_ID, Article_ID) VALUES (" & intTagID & "," & intArticleID & ")")
            Next i
            
            db.Execute ("DELETE * FROM zztblArticles WHERE Sourcing_Date = " & rszztblArticles!Sourcing_Date)
        .MoveNext
    
    Loop
    
    .Close
    
    End With
    
    Set db = Nothing
    db.Close
    MsgBox ("Your articles have been uploaded successfully")
    
    Exit Sub
            
End Sub

Thanks!
 
RainLover said:
I would suggest that you step through the code to see what is happening and what is not.
Click to expand...
You said you found a solution which is good.

If you had followed my suggestion # 5 you would have learnt how to solve many of problems that have a similar grounding.
VBA in post 8 also suggest the same.
 
You must log in or register to reply here.

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom