I always forget to write subject in email, so I want make the subject field compulsory.
Can you help me please?
Private Sub Application_ItemSend(ByVal Item As Object, ByRef Cancel As Boolean)
If Item.Subject = "" Then
Item.Subject = InputBox("Please do not always forget the subject!")
End If
If Item.Subject = "" Then
MsgBox "Won't send this without a subject."
Cancel = True
End If
End Sub
Do While Item.Subject = ""
Item.Subject = InputBox("..")
Loop
I have a similar routine which just checks if I mention the word attachment, and will prompt me if I want to cancel the send, and I have to put in the line:
Item.Display
so that I can go add the attachment. This way you can just prompt with a messagebox saying to add the subject...
Related
I would like add an acronym of my name at the end of the mail subject if sending it from a specific mailbox.
Example:
I have two mailboxes in Outlook, mail1#mail.com and mail2#mail.com.
When sending mail from mail1#mail.com the code should check if the acronym is present in the subject, if not add it.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim xText As String
'text I would like to add at the end of mail subject
xText = "/MX"
If oAccount = "mail1#mail.com" Then 'part which does not work
If InStr(Item.Subject, xText) = False Then
Item.Subject = Item.Subject & " " & xText
End If
End If
End Sub
You should get the result required with .SendUsingAccount rather than Account.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim xText As String
If Item.Class = olmail Then
'text I would like to add at the end of mail subject
xText = "/MX"
Debug.Print Item.SendUsingAccount
If Item.SendUsingAccount = "mail1#mail.com" Then
If InStr(Item.Subject, xText) = False Then
Debug.Print Item.Subject
'If item cannot be edited post another question
End If
End If
' for testing, cancel ALL sending
' remove to allow sending
Cancel = True
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
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.
I am trying to write a macro that looks at the subject line of an email whenever the user hits the Send button.
However I can't find any documentation that listens to that button. For right now I am just trying to get it to send a MsgBox with the subject when the email is sent. Is there a way to listen (thinking in terms of DOMs) to this button and fire a macro on the click.
As suggested by Siddharth:
I have written a small demo which checks some conditions to decide, if the send operation should be canceled. This could be extended to do other things like inserting dates, saving the mails to some folder, ...
Option Explicit
Private Sub Application_ItemSend(ByVal objItem As Object, Cancel As Boolean)
Dim mi As MailItem
If TypeName(objItem) = "MailItem" Then
Set mi = objItem
Debug.Print mi.Subject
check Cancel, Trim(mi.Subject) <> "", "Subject is empty!"
check Cancel, Not isRecipient(mi, "John#Doe.net"), _
"John is on our embargo list!"
End If
End Sub
Private Sub check(ByRef Cancel As Boolean, cond As Boolean, msg As String)
If Not (Cancel Or cond) Then
Cancel = (MsgBox(msg & vbCrLf & "Cancel send operation?", _
vbYesNoCancel, "Confirm?") <> vbNo)
End If
End Sub
Private Function isRecipient(mi As MailItem, forbidden As String) As Boolean
Dim ret As Boolean
Dim rc As Recipient
ret = False
For Each rc In mi.recipients
If StrComp(rc.Address, forbidden, vbTextCompare) = 0 Then
ret = True
Exit For
End If
Next
isRecipient = ret
End Function