Solved

Bug in VBA Code to loop and repeat records in another table

Posted on 2013-12-10
6
267 Views
Last Modified: 2013-12-10
The below function should take records from the query ppPidList2 and append them one at a time as many times as the field REPEAT says in the table tblPrint.

Instead it locks the PC as it continues to add the first record to infinity.

Function MakeData()
Dim StrSQL As String
Dim db As Database                  'Current database.
Dim lng As Long                     'Loop controller.
Dim rs As DAO.Recordset             'Table to append to.
Dim lng1 As Long                     'Loop controller.
Dim rs1 As DAO.Recordset             'Table to append from.
Dim ACCOUNT As String
Dim YEAR As String
Dim USER As String
Dim REPEAT As Integer
Dim TYPEREC As String

    
'StrSQL = "Delete * from tblPrint where user =" & fOSUserName() & ";"
'DoCmd.SetWarnings False
'DoCmd.RunSQL StrSQL
'DoCmd.SetWarnings True

 
    Set db = DBEngine(0)(0)
    Set rs1 = db.OpenRecordset("select * from ppPidList2 ;")
    Set rs = db.OpenRecordset("tblPrint", dbOpenDynaset, dbAppendOnly)
    
      Do While Not rs1.EOF
           ACCOUNT = rs1!ACCOUNT
           YEAR = rs1!YEAR
           USER = rs1!USER
           REPEAT = rs1!REPEAT
           TYPEREC = rs1!TYPE
           
    Set rs = db.OpenRecordset("tblPrint", dbOpenDynaset, dbAppendOnly)
    With rs
        For lng = 1 To REPEAT
            .AddNew
            !ACCOUNT = ACCOUNT
            !YEAR = YEAR
            !USER = USER
            !TYPE = TYPEREC
            .Update
        Next
    End With
    rs.Close
       Loop
    Set rs = Nothing
    Set db = Nothing
        Set rs1 = Nothing
    Set db = Nothing
    End Function

Open in new window

0
Comment
Question by:shelbyinfotech
6 Comments
 
LVL 46

Expert Comment

by:Martin Liss
ID: 39709845
Between lines 40 and 41 add
.MoveNext
0
 
LVL 46

Assisted Solution

by:Martin Liss
Martin Liss earned 250 total points
ID: 39709849
Or perhaps between 43 and 44
0
 
LVL 15

Accepted Solution

by:
ChloesDad earned 250 total points
ID: 39709918
Yes Martin, it should be after line 43
0
The Eight Noble Truths of Backup and Recovery

How can IT departments tackle the challenges of a Big Data world? This white paper provides a roadmap to success and helps companies ensure that all their data is safe and secure, no matter if it resides on-premise with physical or virtual machines or in the cloud.

 
LVL 120

Expert Comment

by:Rey Obrero (Capricorn1)
ID: 39709930
try this revision , look for   'add this line
Function MakeData()
Dim StrSQL As String
Dim db As Database                  'Current database.
Dim lng As Long                     'Loop controller.
Dim rs As DAO.Recordset             'Table to append to.
Dim lng1 As Long                     'Loop controller.
Dim rs1 As DAO.Recordset             'Table to append from.
Dim ACCOUNT As String
Dim YEAR As String
Dim USER As String
Dim REPEAT As Integer
Dim TYPEREC As String

    
'StrSQL = "Delete * from tblPrint where user =" & fOSUserName() & ";"
'DoCmd.SetWarnings False
'DoCmd.RunSQL StrSQL
'DoCmd.SetWarnings True

 
    Set db = DBEngine(0)(0)
    Set rs1 = db.OpenRecordset("select * from ppPidList2 ;")
    Set rs = db.OpenRecordset("tblPrint", dbOpenDynaset, dbAppendOnly)
    
      Do While Not rs1.EOF
           ACCOUNT = rs1!ACCOUNT
           YEAR = rs1!YEAR
           USER = rs1!USER
           REPEAT = rs1!REPEAT
           TYPEREC = rs1!TYPE
           
    Set rs = db.OpenRecordset("tblPrint", dbOpenDynaset, dbAppendOnly)
			With rs
				For lng = 1 To REPEAT
					.AddNew
					!ACCOUNT = ACCOUNT
					!YEAR = YEAR
					!USER = USER
					!TYPE = TYPEREC
					.Update
				Next
			End With
			rs.Close
			
			rs1.Movenext   'add this line
			
       Loop
    Set rs = Nothing
    Set db = Nothing
        Set rs1 = Nothing
    Set db = Nothing
    End Function
                                  

Open in new window

0
 

Author Comment

by:shelbyinfotech
ID: 39709937
Thanks !
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 39709946
Incidentally, all those line like
Set object = Nothing 

Open in new window

lines are redundant.
They don't do anything that simply doesn't happen when the objects go out of scope - the end of the procedure in this case. VB(A) does that automatically
0

Featured Post

Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

No matter the version of Windows you are using, you may have some problems with Windows Search running too slow or possibly not running at all. Before jumping into how you can solve this issue, just know there are many other viable alternative deskt…
Preparing an email is something we should all take special care with – especially when the email is for somebody you may not know very well. The pressures of everyday working life stacked with a hectic office environment can make this a real challen…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
The viewer will learn how to  create a slide that will launch other presentations in Microsoft PowerPoint. In the finished slide, each item launches a new PowerPoint presentation and when each is finished it automatically comes back to this slide: …

813 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

10 Experts available now in Live!

Get 1:1 Help Now