Begin Dialog TimesDialog 50,25,197,81,"How many times to replicate?", .displayIt OKButton 48,42,40,14, "OK", .OKButton1 CancelButton 96,42,40,14, "Cancel", .CancelButton1 Text 13,5,28,14, "Database:", .Text1 Text 46,5,120,14, "Text", .Text2 TextBox 45,19,40,14, .TextBox1 Text 89,20,83,14, "(Please enter a positive integer)", .Text3 Text 13,19,29,14, "Count:", .Text3 End Dialog ' DBMultiply - Copy each record multiplier_field times ' Ravichandran Subramanian, ravisdxb@gmail.com Option Explicit Dim dbfrom,dbto As Database Dim tabdef As TableDef Dim rsfrom,rsto As RecordSet Dim recfrom,recto As Record Dim fromfile,tofile As String '------------------------------------------------------------------ Sub Main IgnoreWarning(True) fromfile="data" tofile="data_multiplied" Call multiply() Client.RefreshFileExplorer Exit Sub End Sub '----------------------------------------------------- Function multiply() Dim percentComplete As Object Dim fld As Field Dim pct,x,i,j,k,multiplier As Integer Dim recs As Double Set dbfrom=Client.OpenDatabase(fromfile) Set tabdef=dbfrom.TableDef Set dbto=Client.NewDatabase(tofile,"",tabdef) Set tabdef=dbto.TableDef tabdef.Protect=False Set rsto=dbto.RecordSet Set rsfrom=dbfrom.RecordSet recs=rsfrom.Count ' progress bar Set percentComplete = CreateObject ("CommonIdeaControls.StandaloneProgressCtl") percentComplete.Start "Progress" ' outer loop for number of times to replicate rsfrom.ToFirst ' outer loop for number of rows in the selected database For i=1 To recs rsfrom.Next Set recfrom=rsfrom.ActiveRecord multiplier=recfrom.getNumValue("MULTIPLIER_FIELD") For j=1 To multiplier Set recto=rsto.NewRecord For k=1 To tabdef.Count Set fld=tabdef.GetFieldAt(k) Select Case fld.Type Case 3 'character recto.SetCharValue fld.Name,recfrom.GetCharValue(fld.Name) Case 4 'number recto.SetNumValue fld.Name,recfrom.GetNumValue(fld.Name) Case 5 'date recto.SetDateValue fld.Name,recfrom.GetDateValue(fld.Name) Case 11 'time recto.SetTimeValue fld.Name,recfrom.GetTimeValue(fld.Name) End Select Next rsto.AppendRecord recto Next ' update progress bar pct=Int(i/recs*100) percentComplete.Progress pct percentComplete.Start "Copied " & i & " / " & recs Next tabdef.Protect=True dbto.CommitDatabase End Function