vihaan
asked on
MS Access VBA Delete
Hi ,
Problem Is When the user tries to multiple records at a time on the form . I do not want to let him do that. I should allow the user to delete one record at a time. So whenever the count of records ,that the user is trying to delete is more than 1 , cancel the operation . Whenever , the count is 1 , perform the deletion. PLease iam trying to achieve this in vba So please Help me out. Code please.
Problem Is When the user tries to multiple records at a time on the form . I do not want to let him do that. I should allow the user to delete one record at a time. So whenever the count of records ,that the user is trying to delete is more than 1 , cancel the operation . Whenever , the count is 1 , perform the deletion. PLease iam trying to achieve this in vba So please Help me out. Code please.
ASKER
HI FYed. thanks alot for replying. But the first answer does not apply because i am using 2003 and instead of going through other answers, which you have sent. Can i do that through code in vba.
It's been a while since I have used 2003, but as I recall, in one of the main menus, you can turn off the standard menu bar and hide the database window. I generally do this in all of the applications that I wrote for someone else. Then, I would create my own "menus" on each of my forms, using labels across the top of each form. Each of these labels would be tied to a shortcut menu via the click event (see example)
Private sub lbl_Form_Click
CommandBars("MyFormMenu"). ShowPopup
End Sub
This technique allows me to set the forms "Shortcut Menu" property to False to disable the right click shortcuts.
Then, I use vba code (see code segments below) to actually create the shortcut menus. This method is extremely flexible, and much more portable than the standard method of customizing the toolbars. The attached code module contains several of the subroutines I use for creating shortcut menus, and the function code associated with them.
Private sub lbl_Form_Click
CommandBars("MyFormMenu").
End Sub
This technique allows me to set the forms "Shortcut Menu" property to False to disable the right click shortcuts.
Then, I use vba code (see code segments below) to actually create the shortcut menus. This method is extremely flexible, and much more portable than the standard method of customizing the toolbars. The attached code module contains several of the subroutines I use for creating shortcut menus, and the function code associated with them.
Option Compare Database
Option Explicit
Const BarPopup = 5
Const ControlButton = 1
Const ControlEdit = 2
Const ControlComboBox = 4
Const ButtonUp = 0
Const ButtonDown = -1
Public Function CmdBarExists(BarName As String) As Boolean
Dim intControls
On Error Resume Next
intControls = CommandBars(BarName).Controls.Count
If Err.Number = 0 Then
CmdBarExists = True
Else
CmdBarExists = False
End If
End Function
Public Sub DeleteCmdBar(BarName As String)
Dim intLoop As Integer
'If an error is generated, it is because the command bar doesn't exist, ignore it
On Error GoTo DeleteCmdBar_Error
CommandBars(BarName).Delete
Exit Sub
DeleteCmdBar_Error:
Err.Clear
End Sub
Public Sub MenuForm()
Dim cbr As Object
Dim cbrButton As Object
If CmdBarExists("MyFormMenu") Then Exit Sub
On Error GoTo FormMenuError
DoCmd.Hourglass True
Set cbr = CommandBars.Add("MyFormMenu", BarPopup, , True)
With cbr
Set cbrButton = cbr.Controls.Add(ControlButton, , , , True)
With cbrButton
.Caption = "&Close"
.Tag = "Close"
.OnAction = "=fnCloseForm()"
End With
Set cbrButton = cbr.Controls.Add(ControlButton, , , , True)
With cbrButton
.Caption = "&Quit"
.Tag = "Quit"
.OnAction = "=fnQuit()"
End With
End With
DoCmd.Hourglass False
Exit Sub
FormMenuError:
MsgBox "ReportMenu error" & vbCrLf
End Sub
Public Function fnCloseForm()
Dim frm As Form
Set frm = Screen.ActiveForm
On Error Resume Next
frm.AllowClose = True
DoCmd.Close acForm, frm.Name
End Function
Public Function fnQuit()
Dim intFormLoop As Integer
Dim frm As Form
For intFormLoop = Forms.Count To 1 Step -1
Set frm = Forms(intFormLoop - 1)
On Error Resume Next
frm.AllowClose = True
DoCmd.Close acForm, frm.Name
Next
DoCmd.Quit
End Function
Public Sub MenuText(Optional Reset As Boolean = False)
Dim cbr As Object
Dim cbrButton As Object
'If the commandbar exists, and Reset is false, then exit
If CmdBarExists("MyTextMenu") Then
If Reset = False Then
Exit Sub
Else
DeleteCmdBar "MyTextMenu"
End If
End If
On Error GoTo TextMenuError
DoCmd.Hourglass True
Set cbr = CommandBars.Add("MyTextMenu", BarPopup, , True)
With cbr
Set cbrButton = cbr.Controls.Add(ControlButton, , , , True)
With cbrButton
.Caption = "&Copy"
.Tag = "Copy"
.OnAction = "=fnTextCopy()"
End With
Set cbrButton = cbr.Controls.Add(ControlButton, , , , True)
With cbrButton
.Caption = "&Paste"
.Tag = "Paste"
.OnAction = "=fnTextPaste()"
End With
Set cbrButton = cbr.Controls.Add(ControlButton, , , , True)
With cbrButton
.begingroup = True
.Caption = "&Spell check"
.Tag = "Spell check"
.OnAction = "=fnTextSpell()"
End With
End With
DoCmd.Hourglass False
Exit Sub
TextMenuError:
MsgBox Err.Number & vbCrLf & Err.Description, vbInformation + vbOKOnly, "TextMenu error:"
End Sub
Public Function fnTextCopy()
Dim frm As Form
Dim ctrl As Control
Set frm = Screen.ActiveForm
Do While frm.ActiveControl.ControlType = acSubform
Set frm = frm.ActiveControl.Form
Loop
Set ctrl = frm.ActiveControl
If ctrl.SelLength = 0 Then
ctrl.SelStart = 0
ctrl.SelLength = Len(ctrl.Text)
End If
DoCmd.RunCommand acCmdCopy
End Function
Public Function fnTextPaste()
Dim frm As Form
Dim ctrl As Control
On Error GoTo TextPasteError
Set frm = Screen.ActiveForm
Do While frm.ActiveControl.ControlType = acSubform
Set frm = frm.ActiveControl.Form
Loop
Set ctrl = frm.ActiveControl
DoCmd.RunCommand acCmdPaste
Exit Function
TextPasteError:
If Err.Number = 2046 Then
Resume Next
Else
DisplayError ("Error encountered while attempting to paste text!")
End If
End Function
Public Function fnTextSpell()
Dim frm As Form
Dim ctrl As TextBox
On Error GoTo SpellError
Set frm = Screen.ActiveForm
Do While frm.ActiveControl.ControlType = acSubform
If Application.Version > 11 And Application.Build < 6322 Then
MsgBox "Unable to spell check this item!"
Exit Function
Else
Set frm = frm.ActiveControl.Form
End If
Loop
Set ctrl = frm.ActiveControl
With ctrl
If ctrl.SelLength = 0 Then
ctrl.SelStart = 0
ctrl.SelLength = Len(ctrl.Text)
End If
End With
If ctrl.SelLength > 0 Then DoCmd.RunCommand acCmdSpelling
Exit Function
SpellError:
DisplayError ("Error encountered by spell checker")
End Function
Public Sub MenuReport(Optional Reset As Boolean = False)
Dim cbr As Object 'As CommandBar
Dim cbrButton As Object
Dim cbrCombo As Object 'CommandBarComboBox
Dim cbrCombo1 As Object, cbrCombo2 As Object
Dim cbrEdit As Object
Dim strSQL As String
Dim rs As DAO.Recordset
If CmdBarExists("MyReportMenu") Then
If Reset = False Then
Exit Sub
Else
DeleteCmdBar ("MyReportMenu")
End If
End If
On Error GoTo ReportMenuError
DoCmd.Hourglass True
Set cbr = CommandBars.Add("MyReportMenu", BarPopup, , True)
With cbr
Set cbrButton = cbr.Controls.Add(ControlButton, , , , True)
With cbrButton
.Caption = "&Print"
.Tag = "Print"
.OnAction = "=fnReportPrint()"
End With
Set cbrButton = cbr.Controls.Add(ControlButton, , , , True)
With cbrButton
.Caption = "Save as &RTF"
.Tag = "Save as RTF"
.OnAction = "=fnReportSave('RTF')"
.begingroup = True
End With
If IsPDFInstalled() = True Then
Set cbrButton = cbr.Controls.Add(ControlButton, , , , True)
With cbrButton
.Caption = "Save as &PDF"
.Tag = "Save as PDF"
.OnAction = "=fnReportSave('PDF')"
End With
End If
Set cbrCombo = cbr.Controls.Add(ControlComboBox, , , , True)
With cbrCombo
.Width = 0.25
If (Application.Version = 12) And (IsPDFInstalled = True) Then
.AddItem "PDF"
End If
.AddItem "RTF"
.Caption = "Send as:"
.Tag = "SendReport"
.OnAction = "=fnReportSend()"
.begingroup = True
End With
Set cbrButton = cbr.Controls.Add(ControlButton, , , , True)
With cbrButton
.Caption = "&Close"
.Tag = "Close"
.OnAction = "=fnReportClose()"
.begingroup = True
End With
End With
DoCmd.Hourglass False
Exit Sub
ReportMenuError:
MsgBox Err.Number & vbCrLf & Err.Description, , "ReportMenu error"
End Sub
Public Function fnReportPrint()
Dim rpt As Report, strRptName As String
Dim strMsg As String
Dim intResponse As Integer, bPrint As Boolean
On Error GoTo PrintReportError
Set rpt = Reports(Reports.Count - 1)
strRptName = rpt.Name
bPrint = True
If rpt.Pages > 10 Then
strMsg = "This report contains " & rpt.Pages & " pages! " _
& vbCrLf & vbCrLf _
& "Print this report anyway?"
intResponse = MsgBox(strMsg, vbOKCancel, "Excessive pages")
If intResponse = vbCancel Then bPrint = False
End If
If bPrint Then
With rpt
Application.RunCommand acCmdPrint
End With
End If
Exit Function
PrintReportError:
If Err.Number = 2501 Then
'do nothing (print was cancelled)
Else
DisplayError ("Error in fnReportPrint")
End If
End Function
Public Function fnReportSave(OutputFormat As String)
Dim rpt As Report
On Error GoTo SaveReportError
If Reports.Count = 0 Then
Exit Function
Else
Set rpt = Reports(Reports.Count - 1)
End If
Select Case OutputFormat
Case "HTML"
DoCmd.OutputTo acOutputReport, rpt.Name, acFormatHTML, , True
Case "RTF"
DoCmd.OutputTo acOutputReport, rpt.Name, acFormatRTF, , True
Case "PDF"
DoCmd.OutputTo acOutputReport, rpt.Name, "PDF Format (*.pdf)", , True
Case Else
'do nothing
End Select
SaveReportExit:
Exit Function
SaveReportError:
If Err.Number = 2501 Then
Exit Function
ElseIf Err.Number = 2282 Then
MsgBox WrapText("Your system does not currently have the ability to save a file " _
& "in a PDF format." & vbCrLf _
& "Contact your system administrator to request addition of this " _
& "functionality to your suite of MS Office tools!", 65)
Else
DisplayError ("Error encountered while printing report")
End If
End Function
Public Function fnReportSend()
Dim cbr As Object
Dim cbrCombo As Object
Dim strFormat As String
Dim rpt As Report, strReport As String
Dim rs As DAO.Recordset
Set rpt = Reports(Reports.Count - 1)
strReport = rpt.Name
Set cbr = CommandBars("MyReportMenu")
Set cbrCombo = cbr.FindControl(Tag:="SendReport")
If cbrCombo.ListCount = 1 Or cbrCombo.ListIndex = 2 Then
strFormat = acFormatRTF
Else
strFormat = "PDF Format (*.pdf)"
End If
On Error GoTo ReportSendError
DoCmd.SendObject acSendReport, strReport, strFormat, , , , "AWFC\LD Details", , True
ReportSendExit:
Exit Function
ReportSendError:
If Err.Number = 2501 Then
MsgBox "Send email was cancelled!"
ElseIf Err.Number = 2282 Then
MsgBox WrapText("Your system does not currently have the ability to save a file " _
& "in a PDF format." & vbCrLf _
& "Contact your system administrator to request addition of this " _
& "functionality to your suite of MS Office tools!", 65)
Else
DisplayError ("Error encounterd during fnSendReport!")
End If
End Function
Public Function fnReportClose()
Dim rpt As Report
Dim strMsg As String
Dim intResponse As Integer, bPrint As Boolean
On Error GoTo fnReportCloseError
If Reports.Count > 0 Then
DoCmd.Close acReport, Screen.ActiveReport.Name
' DoCmd.Close acReport, Reports(Reports.Count - 1).Name
End If
Exit Function
fnReportCloseError:
If Reports.Count > 0 Then strMsg = " Report: '" & Reports(Reports.Count - 1).Name & "'"
strMsg = "Error encountered in fnCloseReport():" & strMsg
DisplayError (strMsg)
End Function
ASKER
Hi Fyed, thanks alot for replying but i am sorry i do not need all this. Because when a user select multiple records on the continous form and right clicks on the mouse and selects cut it will delete multiple records. So in that case, i need some thing OnDelete Event to say that mutliple records cannot be deleted . i should allow the user to delete only one record.
And i cannot opt for cutsom meus or something like that because, the database has already been delivered to the users. and i am working on a new process which would capture deleted record information So regarding that process i trying to do this. I need to achieve this through vba . if he tries to delete more than one record , a message prompt should appear saying he cannot . Please help me fyed. Iam really thankful to you.
And i cannot opt for cutsom meus or something like that because, the database has already been delivered to the users. and i am working on a new process which would capture deleted record information So regarding that process i trying to do this. I need to achieve this through vba . if he tries to delete more than one record , a message prompt should appear saying he cannot . Please help me fyed. Iam really thankful to you.
Sorry, can't help more than I have.
You might want to try the forms Before Delete event, but I know of no way to determine the number of records which are currently selected in a continuous form.
If you are going to make changes and send it to the customer, what difference does it make what process (standard or custom menues) you use to accomplish this?
You might want to try the forms Before Delete event, but I know of no way to determine the number of records which are currently selected in a continuous form.
If you are going to make changes and send it to the customer, what difference does it make what process (standard or custom menues) you use to accomplish this?
ASKER
right now i am using the standard menu, I do not want to make any changes to the forms like adding buttons, textfields stufflike that. Because this database is used different regions like 10 or so . and my supervisor definitely against it because it is not a godd practice to change what is working fine now. there are possibliites of going wrong. So thats why, i am kind of battling my way out.
Sorry I couldn't be more help. If you don't get any other responses in the next 24 hours, you might want to "Request Attention" by clicking the hyperlink in the bottom right corner of your original message.
ASKER
Thanks for trying .
ASKER
Hi Fyed, But could you check out my other thread may be i could use your help
https://www.experts-exchange.com/questions/25856537/Calling-a-Module.html?anchorAnswerId=30746743#a30746743
check the last comment ( specifically). thank you,
https://www.experts-exchange.com/questions/25856537/Calling-a-Module.html?anchorAnswerId=30746743#a30746743
check the last comment ( specifically). thank you,
vihaan:
Add this code to your form module. Be sure both your OnDelete and BeforeDelConfirm events are set after you paste this.
Add this code to your form module. Be sure both your OnDelete and BeforeDelConfirm events are set after you paste this.
Dim globalDelete As Integer
Private Sub Form_Delete(Cancel As Integer)
globalDelete = globalDelete + 1 ' Count records to delete
Cancel = False
End Sub
Private Sub Form_BeforeDelConfirm(Cancel As Integer, Response As Integer)
If (globalDelete) = 1 Then 'allow the delete
Cancel = False
End If
If (globalDelete > 1) Then 'disallow the delete
Cancel = True
MsgBox "Deletion of multiple records not allowed"
End If
globalDelete = 0
End Sub
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
I prevent this by:
1. Hiding the ribbon bar using:
DisplayRibbon False
Public Sub DisplayRibbon(Optional IsVisible As Boolean = True)
Dim intAction As Integer
If Application.Version < 12 Then
'do nothing
ElseIf IsVisible Then
DoCmd.ShowToolbar "Ribbon", acToolbarYes
Else
DoCmd.ShowToolbar "Ribbon", acToolbarNo
End If
End Sub
2. either disabling the shortcut menu on the form or creating my own.
3. I then add my own delete button to the forms footer. Since only one record can actually have the focus at a time, using the delete button to delete the record that currently has the focus
Private Sub cmd_Delete_Click
Dim strSQL as string
strSQL = "DELETE * FROM yourTable WHERE ID = " & me.txt_ID
currentdb.execute strsql, dbfailonerror
me.requery
End Sub