?
Solved

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

Posted on 2013-12-10
6
Medium Priority
?
272 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
6 Comments
 
LVL 49

Expert Comment

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

Assisted Solution

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

Accepted Solution

by:
ChloesDad earned 1000 total points
ID: 39709918
Yes Martin, it should be after line 43
0
Independent Software Vendors: 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!

 
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

Office 365 Training for IT Pros

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

Question has a verified solution.

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

This article describes how to import an Outlook PST file to Office 365 using a third party product to avoid Microsoft's Azure command line tool, saving you time.
After seeing numerous questions for Dynamic Data Validation I notice that most have used Visual Basic to solve the problem. This suggestion is purely formula based and can be used in multiple rows.
With Secure Portal Encryption, the recipient is sent a link to their email address directing them to the email laundry delivery page. From there, the recipient will be required to enter a user name and password to enter the page. Once the recipient …
Have you created a query with information for a calendar? ... and then, abra-cadabra, the calendar is done?! I am going to show you how to make that happen. Visualize your data!  ... really see it To use the code to create a calendar from a q…
Suggested Courses
Course of the Month12 days, 6 hours left to enroll

752 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