Sage Pastel Evolution is unable to send emails in HTML format.
I am trying to intercept email before it is sent, add information to the subject and body in HTML format.
I placed the following in the ThisOutlookSession module:
Option Explicit
Public WithEvents myOlApp As Outlook.Application
Public Sub Initialize_Handler()
Set myOlApp = Outlook.Application
End Sub
Private Sub myOlApp_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim sPrompt As String
sPrompt = "Are you sure you want to send " & Item.Subject & "?"
If MsgBox(sPrompt, vbYesNo + vbQuestion, "Sample") = vbNo Then
Cancel = True
End If
End Sub
Nothing seems to be happening when I send an email, neither through Evolution nor through Outlook.
Remove everything and try just the following code, make sure to restart Outlook before testing
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
prompt = "Are you sure you want to send " & Item.subject & "?"
If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then
Cancel = True
End If
End Sub
If you use this format, you have to run Initialize_Handler.
If you wish, instead of running it manually, you could do this when Outlook starts.
In the ThisOutlookSession module.
Private Sub Application_Startup
Initialize_Handler
End Sub
Related
When I send an Outlook 2016 appointment, I use following to trigger a VBA code:
Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
How to display data specific to the type "AppointmentItem"?
I expect a Message Box "Do you want to talk about Computer at school",
but I get a Run-time error '438'.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
prompt = "Do you want to talk about " & Item.Subject 'Works
prompt = prompt & " at " & Item.Location 'Error
If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then
Cancel = True
End If
End Sub
If you send a meeting request, the sent item itself is an olMeetingRequest and not an olAppoinmentItem.
You can address the corresponding appointment item by GetAssociatedAppointment
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objAppointment As AppointmentItem
If Item.Class = olMeetingRequest Then
Set objAppointment = Item.GetAssociatedAppointment(False)
Debug.Print objAppointment.Subject
Debug.Print objAppointment.Location
End If
End Sub
I have a code which checks subject and email for a specific string and notifies users with YES/NO option.
When I restart outlook, I need to manually run MACRO to make it work.
I tried below code but I still need to run it manually.
Public WithEvents PasswordCheck As Outlook.Application
Public Sub Initialize_handler()
Set PasswordCheck = Outlook.Application
End Sub
Private Sub PasswordCheck_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim strBody As String
Dim strSubject As String
strSubject = Item.Subject
strBody = Item.Body
UCasePasswd = UCase("Test_123")
prompt = "Are you sure you want to send this email? It contains Password: "
If InStr(1, UCase(strSubject), UCasePasswd) > 0 Or _
InStr(1, UCase(strBody), UCasePasswd) > 0 Then
If MsgBox(prompt, vbYesNo + vbQuestion, "Check for Subject") = vbNo Then
Cancel = True
End If
End If
End Sub
Private Sub PasswordCheck_Startup()
Initialize_handler
End Sub
Change your procedure name
Private Sub PasswordCheck_ItemSend(ByVal Item As Object, Cancel As Boolean)
should be
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
and be stored in the ThisOutlookSession module.
You should also place Option Explicit at the top of your module and declare UCasePasswd and prompt as string variables.
After testing this code worked without need to call it with the Application_Startup() routine as it's a built in event.
Also, I don't think you can re-reference Application_Startup as PasswordCheck_Startup the same way I've never seen Private Sub Workbook_Open() changed to anything else in Excel.
Edit:
This code in ThisOutlookSession worked perfectly - it's the only code in the module.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim strBody As String
Dim strSubject As String
Dim UCasePasswd As String
Dim prompt As String
strSubject = Item.Subject
strBody = Item.Body
UCasePasswd = "TEST_123" 'Rather than use UCASE, just write it in upper case.
prompt = "Are you sure you want to send this email? It contains Password: "
If InStr(UCase(strSubject), UCasePasswd) > 0 Or InStr(UCase(strBody), UCasePasswd) > 0 Then
If MsgBox(prompt, vbYesNo + vbQuestion, "Check for Subject") = vbNo Then
Cancel = True
End If
End If
End Sub
I use 2007 Outlook.
I'm trying to get a code that upon creation of a new email prompts the user to pick one of the fixed radio button options as follows [A]: , [R]:, [F:] , [!]: , Blank (Option to get subject line blank).
I want that selection to be inserted into the subject line automatically.
I found code online but it errors out towards the end of the code.
Private Sub m_colInspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
I pasted this code in the ThisOutlookSession module.
Option Explicit
Private WithEvents m_colInspectors As Outlook.Inspectors
Private WithEvents CurrentInspector As Outlook.Inspector
Private Sub Application_Startup()
Set m_colInspectors = Application.Inspectors
End Sub
Private Sub CurrentInspector_Activate()
Dim oMail As Outlook.MailItem
If Len(UserForm1.SelectedSubject) Then
Set oMail = CurrentInspector.CurrentItem
oMail.Subject = UserForm1.SelectedSubject
End If
Set CurrentInspector = Nothing
End Sub
Private Sub m_colInspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
If TypeOf Inspector.CurrentItem Is Outlook.MailItem Then
If Inspector.CurrentItem.EntryID = vbNullString Then
UserForm1.SelectedSubject = vbNullString
UserForm1.Show
Set CurrentInspector = Inspector
End If
End If
End Sub
I created a form with radio button and a command button where I inserted the following code.
Option Explicit
Public SelectedSubject As String
Private Sub CommandButton1_Click()
If OptionButton1.Value = True Then
SelectedSubject = "Test"
End If
Hide
End Sub
This might get you want you want. Put it under ThisOutlookSession. When the user click on Sends this triggers, meaning they are not able to change the subject line before it is sent. I am using the UserForm1 and the code you are using for that. Add as many radiobuttons as you like and just amend the OptionButton1 to 2 and the value.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim strSubject As String
Dim Prompt$
strSubject = Item.Subject
' Show RadioButtons
UserForm1.Show
' Set Subject Line as the value from the selected RadioButton
strSubject = UserForm1.SelectedSubject
' Set the message subject
Item.Subject = strSubject
strSubject = Item.Subject
' Test if Subject Line is empty
If Len(Trim(strSubject)) = 0 Then
Prompt$ = "Subject is Empty. Are you sure you want to send the Mail?"
If MsgBox(Prompt$, vbYesNo + vbQuestion + vbMsgBoxSetForeground, "Check for Subject") = vbNo Then
Cancel = True
End If
End If
End Sub
The script below works great but I have to manually run the Initialize_handler routine every time I open Outlook for it to work.
Public WithEvents myOlApp As Outlook.Application
Public Sub Initialize_handler()
Set myOlApp = CreateObject("Outlook.Application")
End Sub
Private Sub myOlApp_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
prompt = "Are you sure you want to send " & Item.Subject & "?"
If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then
Cancel = True
End If
End Sub
As far as I can see to make this work automatically I should be able to add the below script to ThisOutlookSession. However this doesn't work and I have no idea why.
My macro security is set properly and it is running the code on startup but for some reason it doesn't work until I manually open the VBA editor click into Initialize_handler and press F5.
Private Sub Application_Startup()
Initialize_handler
End Sub
The convoluted method described here https://msdn.microsoft.com/en-us/library/office/ff865076.aspx indicates "The sample code must be placed in a class module".
I suggest you use the special class module ThisOutlookSession only. You could experiment with your own class module but if you just want this to work then replace all your code with this in ThisOutlookSession.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
prompt = "Are you sure you want to send " & Item.Subject & "?"
If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then
Cancel = True
End If
End Sub
You can instead put it directly in ThisOutlookSession:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
MsgBox "Sent somthing!"
End Sub
As simple as that. Note you need to change your outMail.Display to outMail.Display (True) and there you are, full code:
...
...
...
outMail.Display (True)
On Error Resume Next
bSent = outMail.sent 'This will NOT SEND. Used to get error.
If Err <> 0 Then
'Email was sent. Put followed actions here.
Else
'Email was not sent. Put followed actions here.
End If
On Error GoTo 0
Pros:
You get what you want
It's simple.
Cons:
Excel (or any other runtime you are running this code from) will freeze until you cancel or send email.
I want Outlook to prompt for a password or some sort of authentication on all outgoing mail items, because someone keeps sending on behalf on my account.
I have written:
If Omail.SendUsingAccount = "My Domain Email account typed here" Then
Sub password()
Dim pass As String
pass = InputBox("Enter Password")
If pass <> "thepassword" Then Exit Sub
End Sub
This doesn't work. After I have the correct code can I then just insert that into a custom action rule?
Please use the below code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
prompt$ = "Enter Password to Send Mail"
Dim pass As String
pass = InputBox("Enter Password")
If pass <> "yourpwd" Then
Cancel = True
End If
End Sub
Its tested and its working fine.
make sure you have enabled macro from trust centre.
You can develop a VBA macro where you can handle the ItemSend event of the Application class which is fired whenever an Microsoft Outlook item is sent, either by the user through an Inspector (before the inspector is closed, but after the user clicks the Send button) or when the Send method for an Outlook item, such as MailItem, is used in a program.
For example:
Public WithEvents myOlApp As Outlook.Application
Public Sub Initialize_handler()
Set myOlApp = Outlook.Application
End Sub
Private Sub myOlApp_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim prompt As String
prompt = "Are you sure you want to send " & Item.Subject & "?"
If MsgBox(prompt, vbYesNo + vbQuestion, "Sample") = vbNo Then
Cancel = True
End If
End Sub
You may find the Getting Started with VBA in Outlook 2010 article helpful.