Tosagua
asked on
Excel Required Fields Enforced
We have an Excel based form that needs to be thoroughly completed. In order to enforce completion of the form, we have added code for a Message Box, when the user tries to Print, Save, or Save-And-Send (email as attachment). The Save and Print functions work, but it does not work for the Save & Send. The code we have is:
Private Sub Workbook_BeforePrint(Cance
If Not RequiredFieldsEntered Then Cancel = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Not RequiredFieldsEntered Then Cancel = True
We need the correct code for the Save & Send function.
Any assistance, insight, or suggestions would be graetly appreciated.
Thank you,
Tosagua
End Sub
Private Sub Workbook_BeforeSave_And_Se
If Not RequiredFieldsEntered Then Cancel = True
End Sub
Private Function RequiredFieldsEntered() As Boolean
Dim Cell As Range
If Len(Dir(ThisWorkbook.Path & Application.PathSeparator & "Bypass Field Check.txt")) = 0 Then
For Each Cell In Sheets("PREMIUM FREIGHT APPROVAL FORM").[D7,D9,G29,D31,D33,
If Len(Cell) = 0 Then
MsgBox "There Are Entries Missing. All Information Is Required. "
Cell.Activate
Exit Function
End If
Next Cell
End If
RequiredFieldsEntered = True
End Function
Private Sub Workbook_BeforePrint(Cance
If Not RequiredFieldsEntered Then Cancel = True
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Not RequiredFieldsEntered Then Cancel = True
We need the correct code for the Save & Send function.
Any assistance, insight, or suggestions would be graetly appreciated.
Thank you,
Tosagua
End Sub
Private Sub Workbook_BeforeSave_And_Se
If Not RequiredFieldsEntered Then Cancel = True
End Sub
Private Function RequiredFieldsEntered() As Boolean
Dim Cell As Range
If Len(Dir(ThisWorkbook.Path & Application.PathSeparator & "Bypass Field Check.txt")) = 0 Then
For Each Cell In Sheets("PREMIUM FREIGHT APPROVAL FORM").[D7,D9,G29,D31,D33,
If Len(Cell) = 0 Then
MsgBox "There Are Entries Missing. All Information Is Required. "
Cell.Activate
Exit Function
End If
Next Cell
End If
RequiredFieldsEntered = True
End Function
Update: I did indeed test adding the suggested XML code using the Custom UI Editor and was able to remove the "Send and Save" feature from just one example workbook (a modified version with your original code).
I recommend that you try this method for your control.
-Glenn
References:
Customizing Context Menus in Office 2010 (MSDN)
Office Custom UI Editor (download)
EE-Q28501036.xlsm
I recommend that you try this method for your control.
-Glenn
References:
Customizing Context Menus in Office 2010 (MSDN)
Office Custom UI Editor (download)
EE-Q28501036.xlsm
ASKER
Glenn,
I appreciate your input, but it looks like we're going back to the drawing board.
The intent was to block Save & Send until the form was thoroughly completed. But when the form is completed, the User needs to email it as an attachment to someone else for approval.
We already have a Button on the form for the Approver that creates an Approval email. We are looking at adding a second Button for the User to send an email to the Approver. This way we could block the execution of further code until the Required Cells have been filled in. Is this a workable strategy ?
Tosagua
Code for Approver's Button:
Private Sub CommandButton1_Click()
'Working in Excel 2000-2013
'This example send the last saved version of the Activeworkbook
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Appl
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "PSW1-PremiumFreightApprov
.CC = ThisWorkbook.Sheets("PREMI
.Subject = ThisWorkbook.Sheets("PREMI
.Body = "Premium Freight Is Approved."
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I appreciate your input, but it looks like we're going back to the drawing board.
The intent was to block Save & Send until the form was thoroughly completed. But when the form is completed, the User needs to email it as an attachment to someone else for approval.
We already have a Button on the form for the Approver that creates an Approval email. We are looking at adding a second Button for the User to send an email to the Approver. This way we could block the execution of further code until the Required Cells have been filled in. Is this a workable strategy ?
Tosagua
Code for Approver's Button:
Private Sub CommandButton1_Click()
'Working in Excel 2000-2013
'This example send the last saved version of the Activeworkbook
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Appl
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "PSW1-PremiumFreightApprov
.CC = ThisWorkbook.Sheets("PREMI
.Subject = ThisWorkbook.Sheets("PREMI
.Body = "Premium Freight Is Approved."
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Yes, if you still need an email capability, then I like your option here. However, to avoid the possibility of anyone using the "Save and Send" feature, it should still be disabled so as to limit users to your function.
The good news about that Custom UI is that it only affects this workbook and the S&S feature will return after the workbook is closed.
-Glenn
The good news about that Custom UI is that it only affects this workbook and the S&S feature will return after the workbook is closed.
-Glenn
ASKER
Glenn,
This is the code that we have so far. But it doesn't quite work as required.
If all of the designated cells have entries, it creates the email and attaches the form, as required.
If any of the deignated Cells are blank, the Message Box pops up as required, for each cell that is blank.
But the program doesn't terminate to allow the entries to be made. After you click OK on each Message Box, the program proceeds to create the email anyways.
I'm either missing code or have this coded incorrectly. Any insight would br greatly appreciated.
Tosagua
Private Sub CommandButton3_Click()
'Working in Excel 2000-2013
If Not RequiredFieldsEntered Then Cancel = True
If Len(Dir(ThisWorkbook.Path & Application.PathSeparator & "Bypass Field Check.txt")) = 0 Then
For Each Cell In Sheets("PREMIUM FREIGHT APPROVAL FORM").[D7,D9,F42,G44,D46,
If Len(Cell) = 0 Then
MsgBox "There Are Entries Missing. All Information Is Required. "
Cell.Activate
End If
Next Cell
End If
RequiredFieldsEntered = False
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Appl
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = " "
.CC = ThisWorkbook.Sheets("PREMI
.Subject = ThisWorkbook.Sheets("PREMI
.Body = "Requesting Approval For Premium Freight Charges. Please Review And Advise."
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
This is the code that we have so far. But it doesn't quite work as required.
If all of the designated cells have entries, it creates the email and attaches the form, as required.
If any of the deignated Cells are blank, the Message Box pops up as required, for each cell that is blank.
But the program doesn't terminate to allow the entries to be made. After you click OK on each Message Box, the program proceeds to create the email anyways.
I'm either missing code or have this coded incorrectly. Any insight would br greatly appreciated.
Tosagua
Private Sub CommandButton3_Click()
'Working in Excel 2000-2013
If Not RequiredFieldsEntered Then Cancel = True
If Len(Dir(ThisWorkbook.Path & Application.PathSeparator & "Bypass Field Check.txt")) = 0 Then
For Each Cell In Sheets("PREMIUM FREIGHT APPROVAL FORM").[D7,D9,F42,G44,D46,
If Len(Cell) = 0 Then
MsgBox "There Are Entries Missing. All Information Is Required. "
Cell.Activate
End If
Next Cell
End If
RequiredFieldsEntered = False
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Appl
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = " "
.CC = ThisWorkbook.Sheets("PREMI
.Subject = ThisWorkbook.Sheets("PREMI
.Body = "Requesting Approval For Premium Freight Charges. Please Review And Advise."
.Attachments.Add ActiveWorkbook.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
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.
ASKER
Glenn,
Excellent. It works great.
Thank you very much.
Tosagua
Excellent. It works great.
Thank you very much.
Tosagua
You're welcome.
The "Save and Send" option is a portal to other options. The "Send using E-mail" option calls up the SendMail dialog (in VBA: Application.Dialogs(xlDial
This forum post at technet describes a method for disabling the "Save and Send" option using Custom UI Editor (this allows you to edit the underlying XML construction of the workbook). However, I haven't tested it.
Regards,
-Glenn