Πρόβλημα στην σύνταξη του κώδικα

[γιώργοςΚ]

Καλησπέρα σε όλους τους φίλους,

προσπαθώ να γράψω έναν κώδικα έτσι ώστε να παίρνει τα δεδομένα απο ένα ερώτημα (QryPrint) και να μου τα μάζει σε έναν temporary table (tblWeekData) έτσι ώστε να μπορέσω να τα παρουσιάζω σε μια έκθεση.

Έχω γράψει τον πιο κάτω κώδικα και η vba κτυπά συνεχώς στο DietID το οποίο θέλω να παίρνει απο το απο το ερώτημα. Παραθετω τον κώδικα και θα εκτιμήσω εάν κάποιος φίλος απο το φόρουμ θα μπορούσε να με βοηθήσει

Sub OpenReport()
Dim i As Integer, x As Integer, tmpMax As Integer, TheFood As String
Dim rsSource As DAO.Recordset
Dim rsTarget As DAO.Recordset
CurrentDb.Execute "DELETE * FROM tblWeekPlan"
Set rsTarget = CurrentDb.OpenRecordset("tblWeekPlan", dbOpenDynaset)
For i = 1 To 25
rsTarget.AddNew
rsTarget.Fields("iNum") = i
rsTarget.Update
Next

For i = 1 To 7
Set rsSource = CurrentDb.OpenRecordset("SELECT QryPrint.* FROM QryPrint WHERE DietCode =" & [DietID] & " AND DayCode =" & i & " ORDER BY [Type of Meal]")
If rsSource.RecordCount Then
If tmpMax < rsSource.RecordCount Then tmpMax = rsSource.RecordCount
rsSource.MoveFirst
rsTarget.MoveFirst
For x = 1 To rsSource.RecordCount
rsTarget.FindFirst "iNum=" & x
rsTarget.Edit
TheFood = Nz(DLookup("FoodName", "tblFoodAnalysis", "[FoodID]=" & rsSource.Fields("Food")))
rsTarget.Fields("MealCat") = Nz(rsSource.Fields("[Type of Meal]"), "")
rsTarget.Fields("d" & i) = TheFood & " - " & Nz(rsSource.Fields("Conc"), "")
rsTarget.Update
rsSource.MoveNext
Next
End If
Next
CurrentDb.Execute "DELETE * FROM tblWeekPlan WHERE iNum > " & tmpMax