Solved

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

Posted on 2013-12-10
6
263 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 45

Expert Comment

by:Martin Liss
Comment Utility
Between lines 40 and 41 add
.MoveNext
0
 
LVL 45

Assisted Solution

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

Accepted Solution

by:
ChloesDad earned 250 total points
Comment Utility
Yes Martin, it should be after line 43
0
Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

 
LVL 119

Expert Comment

by:Rey Obrero
Comment Utility
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
Comment Utility
Thanks !
0
 
LVL 76

Expert Comment

by:GrahamSkan
Comment Utility
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

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

PaperPort has a feature called the "Send To Bar". It provides a convenient, drag-and-drop interface for using other installed software, such as Microsoft Office. However, this article shows that the latest Office 2016 apps (installed with an Office …
Outlook Free & Paid Tools
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: …
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

743 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

14 Experts available now in Live!

Get 1:1 Help Now