Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

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

Status
Not open for further replies.
tlallen

tlallen

Technical User
Oct 12, 2016
9
US
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: 
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: 
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: 
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: 
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: 
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"
AQAccess_2013_Conversion_-_fPREPROJECT_tqptae.jpg
. 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.
 
Sort by date Sort by votes
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
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

renigar
  • Locked
  • Question
Code to write file path to field always writes to 1st record 1
Replies
5
Views
279
dhookom
dhookom
Kennelbloke
  • Locked
  • Solved
Refer to Navigation Control Subform Record
Replies
8
Views
462
Kennelbloke
Kennelbloke
Moss100
  • Locked
  • Question
Access send email attachments - problem when null or empty
Replies
7
Views
528
Andrzejek
Andrzejek
M
  • Question
display a calendar with appointments in body of html email with access vba
Replies
1
Views
534
SoftwareRT
SoftwareRT
Moss100
  • Question
Open filtered for and set cursor at particular record
Replies
1
Views
155
Moss100
Moss100

Part and Inventory Search

Sponsor

Back
Top