×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Need assistance converting old Access 2003 dupe record code to Access 2013

Need assistance converting old Access 2003 dupe record code to Access 2013

Need assistance converting old Access 2003 dupe record code to Access 2013

(OP)
Good evening,

I am working in our public agency's Microsoft Access database which has undergone many conversions over time (MS Access 2000, 2003, 2007 and now 2013). Every now and then I run into an old command program that seems to no longer work in my Access 2013 on my new Windows 10 OS. I discovered such an issue this week, but I am not an advanced programmer. Prior to Windows 10 OS, I was able to use "Control + D" or a Dupe Command button on right-click to duplicate an entire record to a new record with a new project ID number. The Project ID field is my key field. Now, when I use either of these, the record duplicates, but overwrites the last record in the database instead of duping to a blank record and creating a new Project ID, leaving the old record's Project ID number. I have spent days trying to figure out in the VBA what is happening. I know there are a few command changes necessary, but I have not had to program in a while. I located this in the programming background which I am not sure is Access 2013 language.

Case "acCmdDuplicate"
DoCmd.RunCommand acCmdDuplicate

I located the following codes associated with the Dupe or Duplicate record command in several of my forms.

CODE --> vba

cmdDupe
Private Sub cmdDUPE_Click()
Dim Response
Response = MsgBox("A duplicate of the current record will be created.  Do you want to continue?", 36)
    If Response = vbYes Then GoTo GenDupe
Exit Sub
GenDupe:
DoCmd.SetWarnings True
'add refresh 5/13/03 - will this fix it?
Me.Refresh
Dim frst As Recordset
'set up a blank form
'copy data from the prior record to the new record
Set frst = Me.RecordsetClone
frst.FindFirst "[Fchem_ID] = " & Me![ipFchemID]
If frst.NoMatch Then
    MsgBox ("No match for number entered!")
    frst.Close
    Exit Sub
End If
Me.AllowAdditions = True
[ipPolCode].SetFocus
Do Until Me.NewRecord
    SendKeys "{PGDN}", True
Loop
Me![ipPerID] = frst![Per_ID]
Me![ipFacID] = frst![Fac_ID#]
'the following statement may be a misnomer; replaced w. 2nd stmt:
'Me![ipPermARMS] = frst![ARMS#]
'Me![ipPermARMS] = frst![PermARMS]
'Populate the detail
'Me![ipEFactID] = frst![EFACT_ID]
Me![ipSCC_CODE] = frst![SCC_CODE]
Me![ipSearchCode] = frst![SCC_CODE]
Me![ipPolCode] = frst![POL_CODE]
Me![ipCASNumber] = frst![CASNUMBER]
Me![ipEmplNo] = frst![Empl_No]
Me![ipInvYr] = frst![Inv_Yr]
Me![ipEmissionType] = frst![Emission Type]
Me![ipSrcCat] = frst![Src_Cat]
'do we want Data_SRC?
'Me![ipDataSrc] = frst![DATA_SRC]
'Me![ipAQDsrc] = frst![AQD_src]
'do we want ProcessRate?
Me![ipProcessRate] = frst![ProcessRate]
'Me![ipProcessRatePrev] = frst![ProcessRate Prev]

'Me![ipEFAdjust] = frst![EFAdjust]
'Me![ipEFPrev] = frst![EF_Prev]
'Me![ipEFVAL] = frst![EFVAL]

'Added to Dupe to replace Chem_Cat - ME 4/9/03
'Me![ipDEPCode] = frst![DEP Code]
'Me![ipChemCat] = frst![Chem_Cat]

Me![HoursDay] = frst![HoursDay]
Me![DaysWeek] = frst![DaysWeek]
Me![ipHrsYear] = frst![HrsYear]
Me![DJF] = frst![DJF]
Me![MAM] = frst![MAM]
Me![JJA] = frst![JJA]
Me![SON] = frst![SON]
Me![ipO3hrsDay] = frst![O3hrsDay]
Me![ipO3DaysWk] = frst![O3DaysWk]
Me![ipO3days] = frst![O3days]
Me![ipO3ProcessRate] = frst![O3ProcessRate]

'Me![ipComments] = frst![Comments]
'Me![ipCommentsPrev] = frst![Comments Prev]
Me![frmRecCount].Requery
MsgBox ("This is a new record created by duplicating FAC_CHEM ID : " & Str(frst![Fchem_ID]))
Me.AllowAdditions = False
End Sub 


The second code, which is associated with the issue I discussed if this:

CODE --> vba

Private Sub ipPerID_DblClick(Cancel As Integer)
'causes the creation of duplicate records
If IsNull(Me.Parent![fDupeFacID]) Then
    MsgBox ("FAC_CHEM records need to be selected for copying!")
    Exit Sub
End If
Dim Response
Dim CR
CR = Chr(13)
Response = MsgBox("Copy records?" & CR & "From:" & CR & "  FacID:" & Me.Parent![fDupeFacID] & CR & "  PerID:" & Me.Parent![fDupePerID] & CR & "  For:" & Me.Parent![fDupeInvYr] & CR & "To:" & CR & "  FacID:" & Me![ipFacID] & CR & "  PerID:" & Me![ipPerID], 36)
    If Response = vbYes Then GoTo OwnerDelete
    MsgBox ("Records will not be copied!")
    Exit Sub
OwnerDelete:
DoCmd.SetWarnings False
DoCmd.OpenQuery "qAORCopy2"
Forms![fAOR01]![fAORData].Requery
DoCmd.SetWarnings True
Me.Parent![fDupeFacID] = Null
End Sub 

CODE --> vba

Option Compare Database
Option Explicit
Dim DeleteProjID As Long

Private Sub Form_AfterDelConfirm(Status As Integer)
If Status = 0 Then
    MsgBox ("Proj_ID " & Str(DeleteProjID) & " has been deleted.")
    Me.Requery
End If
End Sub

Private Sub Form_BeforeUpdate(Cancel As Integer)
'this routine validates the record
Dim Response As Integer
If IsNull([ipEmployeeNo]) Then
    DoCmd.CancelEvent
    MsgBox ("Missing employee information!")
    [ipEmployeeNo].SetFocus
End If
If IsNull([ipProjDesc]) Then
    DoCmd.CancelEvent
    MsgBox ("Missing Project Description!")
    [ipProjDesc].SetFocus
End If
If IsNull([ipProjtype]) Then
    DoCmd.CancelEvent
    MsgBox ("Missing Project Type!")
    [ipProjtype].SetFocus
End If
If [ipProjtype] = "enf" And ([ipEmployeeNo] <> "1" And [ipEmployeeNo] <> "39358" And [ipEmployeeNo] <> "101855" And [ipEmployeeNo] <> "21392" And [ipEmployeeNo] <> "36126" And [ipEmployeeNo] <> "36638" And [ipEmployeeNo] <> "100803" And [ipEmployeeNo] <> "31108" And [ipEmployeeNo] <> "34626" And [ipEmployeeNo] <> "23116" And [ipEmployeeNo] <> "33176") And [ipEmployeeNo] <> "15304" And [ipEmployeeNo] <> "23116" And [ipEmployeeNo] <> "3930" And [ipEmployeeNo] <> "20998" And [ipEmployeeNo] <> "99999" And [ipEmployeeNo] Then
    DoCmd.CancelEvent
    MsgBox ("Employee must be All Project Example, Burchfield, Cox, Culliver, Farrington, Froberg, Hennis, Soptei, Martin, McCann, Crane, Brodeur, or Robbins for eft project type!")
    [ipEmployeeNo].SetFocus
End If
If [ipCompleteDate] > Now Then
    Response = MsgBox("The Complete Date is in the future.  Is that ok?", 36)
        If Response = vbYes Then GoTo CheckDueDate
    DoCmd.CancelEvent
    [ipCompleteDate].SetFocus
End If
CheckDueDate:
If [ipDueDate] > DateAdd("yyyy", 2, Now) Then
    Response = MsgBox("Due Date is more than 2 years in the future.  Is that ok?", 36)
        If Response = vbYes Then Exit Sub
    DoCmd.CancelEvent
    [ipDueDate].SetFocus
End If
If ([ipProjtype] = "aorR" Or [ipProjtype] = "ccp" Or [ipProjtype] = "socr" Or [ipProjtype] = "trv" Or _
    [ipProjtype] = "trs" Or [ipProjtype] = "trs2" Or [ipProjtype] = "trs3") Then
    If (Not IsNull([ipCompleteDate])) Then
        If (IsNull([ipPerID]) Or [ipPerID] = 0) Then
        MsgBox ("Per_ID Must Be Entered for this Project!")
        'Me!ipCompleteDate.Undo
         'On Error Resume Next
        [ipPerID].SetFocus
        End If
   End If
End If

End Sub 

CODE --> vba

Private Sub Form_Current()
'primes link
On Error Resume Next
Me.Parent!FormLink1 = Me![ipProjID]
glbProjID = Me![ipProjID]
Me![CurrProjID] = Me![ipProjID]
End Sub 

and this code:

CODE --> vba

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
'If Me.CurrentRecord <> Me.ProjectCount Then
Call UPandDOWN3(KeyCode, Me.CurrentRecord, Me![ProjectCount])
'    GoTo ContKeyDown
'End If
'If KeyCode = vbKeyUp Then
'    SendKeys "^{PGUP}", True
'    Exit Sub
'End If
'If KeyCode = vbKeyDown Then
'    SendKeys "^{PGDN}", True
'    Exit Sub
'End If
'If KeyCode = vbKeyReturn Then
'    SendKeys "^{PGDN}", True
'    Exit Sub
'End If
'ContKeyDown:
If KeyCode = vbKeyAdd Then Exit Sub
If KeyCode = vbKeySubtract Then Exit Sub
'Insert key
If KeyCode = vbKeyInsert Then GoTo GoToNewRec
'Ctrl+DnArrow
If Shift = acCtrlMask And KeyCode = vbKeyDown Then GoTo ChkCtrlDown
'Ctrl+D
If Shift = acCtrlMask And KeyCode = 68 Then GoTo ChkCtrlDupe
If Shift = acCtrlMask And KeyCode = 100 Then GoTo ChkCtrlDupe
'F6 Key
If KeyCode = vbKeyF6 Then GoTo togl
If Shift = acCtrlMask And (KeyCode = 90 Or KeyCode = 122) Then
    Me.Undo
    Exit Sub
End If
Exit Sub
'takes focus to the fProjectMemo subform
ChkCtrlDown:
KeyCode = 0
If IsNull(Me![ipProjID]) Then Exit Sub
'on a new record, this updates the linkage between this form
'and the memo subform
'it also primes a global variable with the new Proj_ID code
'which is used by the fProjectMemo and fProjMemoPopup queries
If Me.NewRecord = True Then
    Me.Parent!FormLink1 = Me![ipProjID]
    glbProjID = Me![ipProjID]
End If
'resets focus to fProjectMemo subform
Forms![fPREPROJECT].SetFocus
Forms![fPREPROJECT]![fProjectMemo].SetFocus
Forms![fPREPROJECT]![fProjectMemo].Form![ipComment].SetFocus
Exit Sub
'duplicate the current record
ChkCtrlDupe:
If Me.NewRecord = True Then Exit Sub
'calls a procedure located in module GenMods that copies
'the record
Call DupeProjRecord
Exit Sub
'Inset key causes focus to go to new record
GoToNewRec:
If Me.NewRecord = True Then Exit Sub
'this takes cursor to last active record
Dim rst As Recordset
Set rst = Me.RecordsetClone
rst.MoveLast
Me.Bookmark = rst.Bookmark
rst.AddNew
rst.Close
'this takes focus down to the new record at the bottom
SendKeys "{PGDN}", True
Me![ipEmployeeNo].SetFocus
Exit Sub
'this changes the focus to either of two forms....if they are open
togl:
KeyCode = 0
If (SysCmd(acSysCmdGetObjectState, A_FORM, "fAsbFac01") <> 0) Then
    Forms![fAsbFac01].SetFocus
ElseIf (SysCmd(acSysCmdGetObjectState, A_FORM, "fFacDetail01") <> 0) Then
    Forms![fFacDetail01].SetFocus
End If
End Sub 

I have attached a snapshot of the form and the dupe on "right-click". Does anyone know what may need updating in my code I provided? Any assistance or guidance is very much appreciated. I have lost a few files to overwriting before I discovered this issue.

RE: Need assistance converting old Access 2003 dupe record code to Access 2013

One problem is that I do not believe that send keys is still supported, and that is a poor design anyways. Not very reliable. This looks overly complicated to me. If I understand correctly you just want to copy all the values from one record to a new record and give it a new ProjectID. That can be done with a single insert query. Instead the open a recordset, do some moving around, copy field by field into a form, blah blah blah. I personally would rewrite it and not trouble shoot, not worth the time. If you could post a simplified version with dummy data I could take a look.

But basically I think this code

CODE -->

Dim frst As Recordset
'set up a blank form
'copy data from the prior record to the new record
Set frst = Me.RecordsetClone
frst.FindFirst "[Fchem_ID] = " & Me![ipFchemID]
If frst.NoMatch Then
    MsgBox ("No match for number entered!")
    frst.Close
    Exit Sub
End If
Me.AllowAdditions = True
[ipPolCode].SetFocus
Do Until Me.NewRecord
    SendKeys "{PGDN}", True
Loop
Me![ipPerID] = frst![Per_ID]
Me![ipFacID] = frst![Fac_ID#]
'the following statement may be a misnomer; replaced w. 2nd stmt:
'Me![ipPermARMS] = frst![ARMS#]
'Me![ipPermARMS] = frst![PermARMS]
'Populate the detail
'Me![ipEFactID] = frst![EFACT_ID]
Me![ipSCC_CODE] = frst![SCC_CODE]
Me![ipSearchCode] = frst![SCC_CODE]
Me![ipPolCode] = frst![POL_CODE]
Me![ipCASNumber] = frst![CASNUMBER]
Me![ipEmplNo] = frst![Empl_No]
Me![ipInvYr] = frst![Inv_Yr]
Me![ipEmissionType] = frst![Emission Type]
Me![ipSrcCat] = frst![Src_Cat]
'do we want Data_SRC?
'Me![ipDataSrc] = frst![DATA_SRC]
'Me![ipAQDsrc] = frst![AQD_src]
'do we want ProcessRate?
Me![ipProcessRate] = frst![ProcessRate]
'Me![ipProcessRatePrev] = frst![ProcessRate Prev]

'Me![ipEFAdjust] = frst![EFAdjust]
'Me![ipEFPrev] = frst![EF_Prev]
'Me![ipEFVAL] = frst![EFVAL]

'Added to Dupe to replace Chem_Cat - ME 4/9/03
'Me![ipDEPCode] = frst![DEP Code]
'Me![ipChemCat] = frst![Chem_Cat]

Me![HoursDay] = frst![HoursDay]
Me![DaysWeek] = frst![DaysWeek]
Me![ipHrsYear] = frst![HrsYear]
Me![DJF] = frst![DJF]
Me![MAM] = frst![MAM]
Me![JJA] = frst![JJA]
Me![SON] = frst![SON]
Me![ipO3hrsDay] = frst![O3hrsDay]
Me![ipO3DaysWk] = frst![O3DaysWk]
Me![ipO3days] = frst![O3days]
Me![ipO3ProcessRate] = frst![O3ProcessRate]

'Me![ipComments] = frst![Comments]
'Me![ipCommentsPrev] = frst![Comments Prev] 

Could likely be replaced by something like

CODE -->

Dim strSql as string
Dim strWhere as string
strWhere = [Fchem_ID] = " & Me![ipFchemID]
strSql = "select * into SomeTable From qryNoProjectID Where " & strWhere
currentdb.execute strSql 

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close