D
Dan @BCBS
I'm trying to track deleted records.
On the main form the data is entered on, I added a command button, to delete
the record. The code to that command button copies the data to a table.
To get a new ID for each deleted record and start the copy over to the table
I'm using: Dim lID As Long
lID = GetNewID("t_DataTrackingDeleted")
I'm getting RunTIme Error 15 - Type Mismatch.
Which takes me to here: Set rs = db.OpenRecordset(tblName)
Here is the code: after this code at the bottom is the Function Code where
I'm getting the error: Set rs = db.OpenRecordset(tblName)
Private Sub cmdDelete_Click()
Dim lCriteria As String
Dim lICCNNO As String
lICCNNO = Me!ICNSR
If MsgBox("Are you sure you want to delete ICN/SR No. " & lICNSR,
vbQuestion & vbYesNo, gappname) = vbYes Then
DoCmd.SetWarnings False
Dim lID As Long
lID = GetNewID("t_DataTrackingDeleted")
lCriteria = "INSERT INTO t_DataTrackingDeleted ( ID, ICNSR,
PVNO, RN_RACF, "
lCriteria = lCriteria & "LetterDate, BCBSreceived,
Appealsreceived, "
lCriteria = lCriteria & "CloseDt, Source, Product, "
lCriteria = lCriteria & "InqType, DeniedCode, DeniedCode2, "
lCriteria = lCriteria & "AgainstCode, AgainstCode2, Comments,
DecisionCode, Status, "
lCriteria = lCriteria & "Expedited, DOS, RSECode, OutofState,
Specialty "
lCriteria = lCriteria & "Who, When, AppealCoordinator ) "
lCriteria = lCriteria & "SELECT " & lID & " AS tID,
t_DataTracking.ICNSR, t_DataTracking.PVNO, "
lCriteria = lCriteria & "t_DataTracking.RN_RACF,
t_DataTracking.LetterDate, "
lCriteria = lCriteria & "t_DataTracking.BCBSreceived,
t_DataTracking.Appealsreceived,"
lCriteria = lCriteria & "t_DataTracking.CloseDt,
t_DataTracking.Source, "
lCriteria = lCriteria & "t_DataTracking.Product,
t_DataTracking.InqType, "
lCriteria = lCriteria & "t_DataTracking.DeniedCode,
t_DataTracking.DeniedCode2,"
lCriteria = lCriteria & "t_DataTracking.AgainstCode,
t_DataTracking.AgainstCode2, "
lCriteria = lCriteria & "t_DataTracking.Comments,
t_DataTracking.DecisionCode, "
lCriteria = lCriteria & "t_DataTracking.Status,
t_DataTracking.Expedited, "
lCriteria = lCriteria & "t_DataTracking.DOS,
t_DataTracking.RSECode, "
lCriteria = lCriteria & "t_DataTracking.OutofState,
t_DataTracking.Speciality, "
lCriteria = lCriteria & "t_DataTracking.Who,
t_DataTracking.When, "
lCriteria = lCriteria & "tblTrackingData.AppealCoordinator, " &
"""" & gcurrentuser & """" & " AS tUser, "
lCriteria = lCriteria & "#" & Format$(Now, "mm\/dd\/yyyy") & "#
AS tDate "
'lCriteria = lCriteria & "#" & Format$(Now, "mm\/dd\/yyyy
hh\:nn\:ss") & "# AS tDate "
'This documents Date & time it was deleted
lCriteria = lCriteria & "FROM t_DataTracking "
lCriteria = lCriteria & "WHERE (((t_DataTracking.ICNSR)=" & """"
& lICCNNO & """" & "));"
DoCmd.RunSQL lCriteria
lCriteria = "DELETE DISTINCTROW t_DataTracking.ICNSR FROM
t_DataTracking "
lCriteria = lCriteria & "WHERE (((t_DataTracking.ICNSR)=" & """"
& lICCNNO & """" & "));"
DoCmd.RunSQL lCriteria
DoCmd.SetWarnings True
DoCmd.GoToRecord , , acNewRec
End If
Forms!f_TrackingData.Refresh
Forms!f_TrackingData.Visible = False
Forms!f_TrackingData.Visible = True
Exit_cmdDelete_Click:
Exit Sub
End Sub
//////////////////////////
Option Compare Database
Option Explicit
Public Function GetNewID(tblName As String) As Long
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset(tblName)
If rs.RecordCount > 0 Then
rs.MoveLast
GetNewID = rs.Fields(0) + 1
Else
GetNewID = 0
End If
End Function
On the main form the data is entered on, I added a command button, to delete
the record. The code to that command button copies the data to a table.
To get a new ID for each deleted record and start the copy over to the table
I'm using: Dim lID As Long
lID = GetNewID("t_DataTrackingDeleted")
I'm getting RunTIme Error 15 - Type Mismatch.
Which takes me to here: Set rs = db.OpenRecordset(tblName)
Here is the code: after this code at the bottom is the Function Code where
I'm getting the error: Set rs = db.OpenRecordset(tblName)
Private Sub cmdDelete_Click()
Dim lCriteria As String
Dim lICCNNO As String
lICCNNO = Me!ICNSR
If MsgBox("Are you sure you want to delete ICN/SR No. " & lICNSR,
vbQuestion & vbYesNo, gappname) = vbYes Then
DoCmd.SetWarnings False
Dim lID As Long
lID = GetNewID("t_DataTrackingDeleted")
lCriteria = "INSERT INTO t_DataTrackingDeleted ( ID, ICNSR,
PVNO, RN_RACF, "
lCriteria = lCriteria & "LetterDate, BCBSreceived,
Appealsreceived, "
lCriteria = lCriteria & "CloseDt, Source, Product, "
lCriteria = lCriteria & "InqType, DeniedCode, DeniedCode2, "
lCriteria = lCriteria & "AgainstCode, AgainstCode2, Comments,
DecisionCode, Status, "
lCriteria = lCriteria & "Expedited, DOS, RSECode, OutofState,
Specialty "
lCriteria = lCriteria & "Who, When, AppealCoordinator ) "
lCriteria = lCriteria & "SELECT " & lID & " AS tID,
t_DataTracking.ICNSR, t_DataTracking.PVNO, "
lCriteria = lCriteria & "t_DataTracking.RN_RACF,
t_DataTracking.LetterDate, "
lCriteria = lCriteria & "t_DataTracking.BCBSreceived,
t_DataTracking.Appealsreceived,"
lCriteria = lCriteria & "t_DataTracking.CloseDt,
t_DataTracking.Source, "
lCriteria = lCriteria & "t_DataTracking.Product,
t_DataTracking.InqType, "
lCriteria = lCriteria & "t_DataTracking.DeniedCode,
t_DataTracking.DeniedCode2,"
lCriteria = lCriteria & "t_DataTracking.AgainstCode,
t_DataTracking.AgainstCode2, "
lCriteria = lCriteria & "t_DataTracking.Comments,
t_DataTracking.DecisionCode, "
lCriteria = lCriteria & "t_DataTracking.Status,
t_DataTracking.Expedited, "
lCriteria = lCriteria & "t_DataTracking.DOS,
t_DataTracking.RSECode, "
lCriteria = lCriteria & "t_DataTracking.OutofState,
t_DataTracking.Speciality, "
lCriteria = lCriteria & "t_DataTracking.Who,
t_DataTracking.When, "
lCriteria = lCriteria & "tblTrackingData.AppealCoordinator, " &
"""" & gcurrentuser & """" & " AS tUser, "
lCriteria = lCriteria & "#" & Format$(Now, "mm\/dd\/yyyy") & "#
AS tDate "
'lCriteria = lCriteria & "#" & Format$(Now, "mm\/dd\/yyyy
hh\:nn\:ss") & "# AS tDate "
'This documents Date & time it was deleted
lCriteria = lCriteria & "FROM t_DataTracking "
lCriteria = lCriteria & "WHERE (((t_DataTracking.ICNSR)=" & """"
& lICCNNO & """" & "));"
DoCmd.RunSQL lCriteria
lCriteria = "DELETE DISTINCTROW t_DataTracking.ICNSR FROM
t_DataTracking "
lCriteria = lCriteria & "WHERE (((t_DataTracking.ICNSR)=" & """"
& lICCNNO & """" & "));"
DoCmd.RunSQL lCriteria
DoCmd.SetWarnings True
DoCmd.GoToRecord , , acNewRec
End If
Forms!f_TrackingData.Refresh
Forms!f_TrackingData.Visible = False
Forms!f_TrackingData.Visible = True
Exit_cmdDelete_Click:
Exit Sub
End Sub
//////////////////////////
Option Compare Database
Option Explicit
Public Function GetNewID(tblName As String) As Long
Dim db As Database
Dim rs As Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset(tblName)
If rs.RecordCount > 0 Then
rs.MoveLast
GetNewID = rs.Fields(0) + 1
Else
GetNewID = 0
End If
End Function