How to load combobox value to CC field in Outlook VBA? - vba

I have a userform combobox that allows users to select a project email. I want to be able to select this email, and click on a button in the userform which loads the email into the CC field. I've got this code right now, but it's giving me an error. Any help is appreciated.
Private Sub Attach_Click()
Set oMsg = Application.ActiveInspector.CurrentItem
Dim objRecip As Recipient
Set objRecip = oMsg.Recipients.Add(Me.cmbPC.column(0))
objRecip.Type = olCC
End Sub
Error that pops up:
The operation failed. The messaging interfaces have returned an unknown error. If the problem persists, restart Outlook. Cannot resolve recipient.

Use the Recipient.Resolve method which attempts to resolve a Recipient object against the Address Book.
Sub CreateAssignedTask()
Dim myItem As Outlook.TaskItem
Dim myDelegate As Outlook.Recipient
Set MyItem = Application.CreateItem(olTaskItem)
MyItem.Assign
Set myDelegate = MyItem.Recipients.Add("Eugene Astafiev")
myDelegate.Resolve
If myDelegate.Resolved Then
myItem.Subject = "Test task"
myItem.Display
End If
End Sub
You may find the How To: Fill TO,CC and BCC fields in Outlook programmatically article helpful.

Related

Send an email with a blank subject

I am a professor interacting with students who do not respond to emails, but who do respond to text messages. So, I am writing an Outlook userform to generate text messages that are sent by Outlook to students' cell phones, e.g., by using email addresses that target the student's cell phone text message service like this: 5405551212#mms.att.net
The problem I am running into is that I don't want to have a Subject for these text messages because that Subject is added as the first line of each text sent to the student and is confusing and looks weird, but, the VBA code olMail.Send will throw this error when the Subject is blank: "Run-time error '-2147467259 (80004005)': Outlook does not recognize one or more names." The names for olMail.To and olMail.CC are fine and the error goes away when I add a non-blank Subject.
Is there a way to programmatically force Outlook to send the email with a blank subject? I have not been able to find a solution searching online other than to make the subject " " (a space)--but that is not an ideal solution because it still adds a "blank" line at the top of each text message because of the space.
I could probably use olMail.Display and then use SendKeys to send the email and answer "Yes" when I am asked if I want to send the email without a subject, but that is clunky.
How can I skip the error and send the email without a subject using VBA?
EDIT:
Here's the code that I was using to add recipients to the mailitem:
Dim olApp As Outlook.Application
Dim olMail As MailItem
olMail.To = Me.tbxEmailAddress 'this would be something like 5405551212#mms.att.net
olMail.CC = "someemail#notmail.com" 'this would be my own email address
olMail.Subject = "" 'blank subject
olMail.Body = Replace(Me.tbxTexts, vbCrLf, "") 'remove extra hard returns
olMail.Send 'this would throw the error mentioned above,
'but if I changed olMail.Subject = "" to
'olMail.Subject = "This is the subject" then no error would occur
Using #Eugene Astafiev's information below, I cobbled together a working solution like this:
Dim myRecipients As Outlook.Recipients
Dim myRecipient As Outlook.Recipient
Dim olApp As Outlook.Application
Dim olMail As MailItem
Set olApp = Outlook.Application
olMail.Subject = "" 'blank subject
olMail.Body = Replace(Me.tbxTexts, vbCrLf, "") 'remove extra hard returns
Set myRecipient = olMail.Recipients.Add(tbxEmailAddress)
myRecipient.Type = olTo 'Type is: olBCC, olCC, olOriginator, or olTo
Set myRecipient = olMail.Recipients.Add("someemail#notmail.com")
myRecipient.Type = olBCC
Set myRecipients = olMail.Recipients
If Not myRecipients.ResolveAll Then
For Each myRecipient In myRecipients
If Not myRecipient.Resolved Then
MsgBox "Could not resolve: " & myRecipient.Name
End If
Next
End If
olMail.Send 'no error now!
Interestingly, no email address using the myRecipients collection ever reported being unable to be resolved. However, when I tried to resolve the individual myRecipient object/item using myRecipient.Resolve then the text message email address (e.g., 5405551212#mms.att.net) would fail to resolve but my own email address would resolve fine.
Maybe this has something to do with 5405551212#mms.att.net not being an address in my Address Book or Contacts?
At any rate, it does send now. (Note: prior to using the myRecipients.ResolveAll, I did succeed in getting the code I originally had to work by using olMail.Display and then olMail.Send and then using SendKeys "%s" twice--the first time to "click" the Send button and the second time to "click" the "Send Anyway" button when Outlook complained there was no subject. But, clearly the VBA code approach is far superior.)
Thanks to everyone for you help!
Outlook doesn't require setting up the Subject line before submitting items. Use the Recipients.ResolveAll method which attempts to resolve all the Recipient objects in the Recipients collection against the Address Book.
Sub CheckRecipients()
Dim MyItem As Outlook.MailItem
Dim myRecipients As Outlook.Recipients
Dim myRecipient As Outlook.Recipient
Set myItem = Application.CreateItem(olMailItem)
Set myRecipients = myItem.Recipients
myRecipients.Add("Eugene Astafiev")
myRecipients.Add("Nate Sun")
myRecipients.Add("Dan Wilson")
If Not myRecipients.ResolveAll Then
For Each myRecipient In myRecipients
If Not myRecipient.Resolved Then
MsgBox myRecipient.Name
End If
Next
End If
End Sub
You may find the following articles helpful:
How To: Fill TO,CC and BCC fields in Outlook programmatically
How To: Create and send an Outlook message programmatically

Add BCC to appointment on button click

I have a custom form in my appointment in which I have a CommandButton and a BCC field.
When the user press my commandButton, I want to add a mail to my BCC field.
Currently I have the following:
Sub CommandButton1_Click()
Set test = Item.Recipients.Add('alice#yahoo.com')
test = (int)Outlook.OlMailRecipientType.olBCC;
Item.Recipients.ResolveAll();
End Sub
I have tried a couple of different things, without any luck.
Thus far, I have only managed to add a standard Recipient, I.e.
Sub CommandButton1_Click()
Set oMsg = Application.ActiveInspector.CurrentItem
With oMsg
.Recipients.Add("test")
End With
End Sub
But it seems to be more convoluted to add a BCC mail
Therefore, how do I add a mail to my BCC field on commandbutton click?
Try this syntax to set the Type property of the recipient, and then resolve all.
Sub CommandButton1_Click()
Set test = Item.Recipients.Add("alice#yahoo.com")
test.Type = olBCC
Item.Recipients.ResolveAll()
End Sub
In your method you're trying to set the Item as an integer (cast from the BCC type), instead of setting the Type property OF the Item
It looks like you just need to modify the Recipients collection of the item:
Sub CommandButton1_Click()
Dim recip as Outlook.Recipient
Set recip = Item.Recipients.Add('alice#yahoo.com')
recip.Type = Outlook.OlMailRecipientType.olBCC;
Item.Recipients.ResolveAll();
End Sub
Note, the MeetingItem recipient can be one of the following OlMeetingRecipientType constants: olOptional, olOrganizer, olRequired, or olResource.
Most probably you will have to create a new MailItem and send it out separately as BCC.
For some reason, the Item.Recipients.ResolveAll() method did not work. Therefore, I skipped writing to a variable, and instead concatenated the type to .Recipients.Add().
Function CommandButton1_Click()
Set oMsg = Application.ActiveInspector.CurrentItem
With oMsg
.Recipients.Add(Mail).Type = 3
End With
End Function
The following works, and can be repeated with multiple recipients.

System administrator unable to send olBCC mail

I have a custom outlook appointment, from which I want to automatically BCC a mail upon sending my a appointment invitation.
Function Item_Send()
Set oMsg = Application.ActiveInspector.CurrentItem
With oMsg
Set objRecip = Item.Recipients.Add("MyEmail#mail.com")
objRecip.Type = olBCC
objRecip.Resolve
End With
Set oMsg = Nothing
End Function
Everything seems to work fine - My email is attached as BCC, and the appointment is successfully being send.
However, in my inbox I'm getting a mail, that the BCC mail could not be reached.
Your message did not reach some or all of the intended recipients.
Subject:
Sent: 18/06/2020 14:49
The following recipient(s) cannot be reached:
MyEmail on 18/06/2020 14:49
'MyEmail#mail.com' on 18/06/2020 14:49
This message could not be sent. Try sending the message again later, or contact your network administrator.
Diagnostic information for administrators:
Error is [0x80070057-0x00000000-0x00000000]. Submit-Message failed:
message id(23), failure enum(7), HResult(0x80070057), EC(-2147024809).
Why is this error occuring? My mail is not incorrect.
It is not clear where the Item object comes from.
First of all, the Type property for MeetingItem recipients can be one of the following OlMeetingRecipientType constants: olOptional, olOrganizer, olRequired, or olResource. If you want to send a BCC I'd recommend creating a new mail item and copy properties to the new item.
Anyway, the Resolve method returns a boolean value which is true if the object was resolved; otherwise, false. For example, that is how you need to check this out:
Sub AssignTask()
Dim myItem As Outlook.TaskItem
Dim myDelegate As Outlook.Recipient
Set MyItem = Application.CreateItem(olTaskItem)
MyItem.Assign
Set myDelegate = MyItem.Recipients.Add("Eugene Astafiev")
myDelegate.Resolve
If myDelegate.Resolved Then
myItem.Subject = "Prepare Agenda For Meeting"
myItem.DueDate = Now + 30
myItem.Display
myItem.Send
End If
End Sub
Be aware, the ItemSend event handler accepts two parameters. For example, the following code in VB.NET works like a charm on my machine:
Imports System.Runtime.InteropServices
' ...
Private Sub OnItemSend(Item As System.Object, ByRef Cancel As Boolean) _
Handles Application.ItemSend
Dim recipient As Outlook.Recipient = Nothing
Dim recipients As Outlook.Recipients = Nothing
Dim mail As Outlook.MailItem = TryCast(Item, Outlook.MailItem)
If Not IsNothing(mail) Then
Dim addToSubject As String = " !IMPORTANT"
Dim addToBody As String = "Sent from my Outlook 2010"
If Not mail.Subject.Contains(addToSubject) Then
mail.Subject += addToSubject
End If
If Not mail.Body.EndsWith(addToBody) Then
mail.Body += addToBody
End If
recipients = mail.Recipients
recipient = recipients.Add("Eugene Astafiev")
recipient.Type = Outlook.OlMailRecipientType.olBCC
recipient.Resolve()
If Not IsNothing(recipient) Then Marshal.ReleaseComObject(recipient)
If Not IsNothing(recipients) Then Marshal.ReleaseComObject(recipients)
End If
End Sub
This event triggers right after the user clicks the Send button in Outlook (before the inspector window is closed) or when the Send method of Outlook items is called. The ItemSend event provides two parameters to the programmer:
The Item object – an Outlook item that is going to be sent. It can be represented by the AppointmentItem, MailItem, MeetingItem, MobileItem, SharingItem, TaskItem classes.
The Cancel parameter – allows you to cancel sending in Outlook. The default value is false. If you set the Cancel parameter to true in the event handler, the sending process is canceled and the inspector window is shown to the user.
Read more about that in the How To: Change an Outlook e-mail message before sending using C# or VB.NET article.

Control contents of email address fields

I want to send the body of a Word document as an email from MS Word 2016.
I want the user to select recipients from the address book. I want them to only be put in the BCC field.
How do I monitor the to/from/CC/BCC fields for changes, and then move those changes to BCC?
The documentation indicates the use of Inspectors, but nothing specific about accessing the contents of these fields.
I have two approaches:
open a new Outlook mail item, load the contents of the Word file to it, and then try to monitor the fields that way.
send directly from Word using the Quick Access Toolbar option "Send to Mail Recipient".
I don't know if that is an option based on what I was reading and if those fields are accessible via VBA.
Code example of what I have so far:
Sub SendDocumentInMail()
Dim bStarted As Boolean
Dim oOutlookApp As Outlook.Application
Dim oItem As Outlook.MailItem
On Error Resume Next
'Get Outlook if it's running
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
'Outlook wasn't running, start it from code
Set oOutlookApp = CreateObject("Outlook.Application")
bStarted = True
End If
'Create a new mailitem
Set oItem = oOutlookApp.CreateItem(olMailItem)
With oItem
'Set the recipient for the new email
.To = "recipient#mail.com"
'Set the recipient for a copy
.CC = "recipient2#mail.com"
'Set the subject
.Subject = "New subject"
'The content of the document is used as the body for the email
.Body = ActiveDocument.Content
.Send
End With
If bStarted Then
'If we started Outlook from code, then close it
oOutlookApp.Quit
End If
'Clean up
Set oItem = Nothing
Set oOutlookApp = Nothing
End Sub
It seems you are interested in the SelectNamesDialog object which displays the Select Names dialog box for the user to select entries from one or more address lists, and returns the selected entries in the collection object specified by the property SelectNamesDialog.Recipients.
The dialog box displayed by SelectNamesDialog.Display is similar to the Select Names dialog box in the Outlook user interface. It observes the size and position settings of the built-in Select Names dialog box. However, its default state does not show Message Recipients above the To, Cc, and Bcc edit boxes.
The following code sample shows how to create a mail item, allow the user to select recipients from the Exchange Global Address List in the Select Names dialog box, and if the user has selected recipients that can be completely resolved, then send the mail item.
Sub SelectRecipients()
Dim oMsg As MailItem
Set oMsg = Application.CreateItem(olMailItem)
Dim oDialog As SelectNamesDialog
Set oDialog = Application.Session.GetSelectNamesDialog
With oDialog
.InitialAddressList = _
Application.Session.GetGlobalAddressList
.Recipients = oMsg.Recipients
If .Display Then
'Recipients Resolved
oMsg.Subject = "Hello"
oMsg.Send
End If
End With
End Sub

Send an email and ReplyAll to it

My task is to send an email containing a report and send another email containing another report to the same email thread by way of replying/forwarding to the sent email (excluding some recipients).
Option Explicit
Sub TestReply()
Dim objApp As Application
Dim objNewMail As Outlook.MailItem
Dim objReply As Outlook.MailItem
Set objApp = Outlook.Application
Set objNewMail = objApp.CreateItem(0)
' Outgoing email
With objNewMail
.Subject = "Test sending email"
.To = "abc#abc.com"
.HTMLBody = "This is the outgoing email."
.Send
End With
' Reply email
Set objReply = objNewMail.ReplyAll
With objReply
.HTMLBody = "This is the reply emal."
.Display
End With
Set objApp = Nothing
Set objNewMail = Nothing
Set objReply = Nothing
End Sub
I can't find a way to send the follow up email (either by reply or forward).
When I try the above code, it says error the item is moved/deleted. I guess it is becaused when the email is sent, the objNewMail odject is also terminated.
I tried adding RE: or FW: to the subject of the original email but then the two emails will not be in the same thread but independent emails.
An additional problem is that I have two email accounts in Outlook: my own email and team email and the reports are to be sent from the team email.
You can determine if an item added to the sent folder matches objNewMail.
In ThisOutlookSession
Option Explicit
Private WithEvents sentFolderItems As Items
Private Sub Application_Startup()
'Set sentFolderItems = Session.GetDefaultFolder(olFolderSentMail).Items
' Reference any folder by walking the folder tree
' assuming the team folder is in the navigation pane
Set sentFolderItems = Session.folders("team mailbox name").folders("Sent").Items
End Sub
Private Sub sentFolderItems_ItemAdd(ByVal Item As Object)
Dim myReplyAll As MailItem
If Item.Class = olMail Then
'do not use InStr unless you change some part of words in original subject
' or another reply will be generated
If Item.Subject = "Test sending email" Then
Set myReplyAll = Item.ReplyAll
With myReplyAll
.HTMLBody = "This is the reply email."
.Display
End With
End If
End If
End Sub
Sub TestReply()
Dim objNewMail As MailItem
'Set objNewMail = CreateItem(olMailItem)
' Add, not create, in non-default folder
Set objNewMail = Session.folders("team mailbox name").folders("Inbox").Items.Add
' Outgoing email
With objNewMail
.Subject = "Test sending email"
.To = "abc#abc.com"
.HTMLBody = "This is the outgoing email."
.Send
End With
End Sub
Note: Application. and Outlook. are not needed when code is in Outlook.
Call Send on the original email (objNewMail) only after you construct the reply.
Right so currently your code is doing this:
Creating a mail, sending it.
Trying to reply to the mailitem object which is already sent.
What you need is an event Hook to catch the mail when it's received by yourself. (assuming this is how you're reply all and removing some recipients for report 2)
Here is how you accomplish this:
First Create a WithEvents as Items call AllMyItems, then a hook in the AllMyItems_ItemAdd, then initialize the event when Outlook Starts using Application_Startup (a built in event)
Be very careful to identify criteria for forwarding / actioning the incoming mail item, since this event code will scan every mail sent to your main inbox and evaluate it. IF you want to further reduce the risk of forwarding a mail item to the wrong person, consider using an outlook rule to sort it into a custom folder, and then setting that folder's location as the Set AllMyItems = line instead of default folder
Option Explicit
'for the Default DL inbox
Private WithEvents AllMyItems As Items
Private Sub Application_Startup()
Dim olapp As Outlook.Application
Dim objNS As Outlook.NameSpace
Set olapp = Outlook.Application
Set objNS = olapp.GetNamespace("MAPI")
'Set myolitems = objNS.GetDefaultFolder(olFolderInbox).Items
'all my items in the main box
Set AllMyItems = objNS.GetDefaultFolder(olFolderInbox).Items
Set olapp = Nothing
Set objNS = Nothing
End Sub
Private Sub AllMyItems_ItemAdd(ByVal Item As Object)
On Error Resume Next
If TypeName(Item) <> "Mailitem" Then
If TypeName(Item) = "ReportItem" Then GoTo 0 'undeliverables shows as a report item
If TypeName(Item) = "MeetingItem" Then GoTo 0
Dim oItem As MailItem
Dim myForward As MailItem
Set oItem = Item
'use the next line to check for a property of the incoming mail, that distinguishes it from other mail, since this event will run on every mail item
If InStr(1, oItem.Subject, "Your public folder is almost full", vbTextCompare) > 0 Then
Set myForward = oItem.Forward
myForward.Recipients.Add "derp#derpinacorp.com"
myForward.Importance = olImportanceHigh
'MsgBox "uno momento"
myForward.Send
Else
End If
Else
End If
0:
End Sub