I sort recipients when composing an email.
If I have 3 recipients (for example), run the sort macro, and then remove a recipient from the To: text box, running the macro a second time causes the removed recipient to re-appear. When I step through the macro on the second run, I can see that both .CurrentItem.To and the Recipients object still have all 3 recipients.
It is intermittent. Is there any way to force the Recipients object to update when the To: text box has been edited?
I can't find anything in the Outlook VBA documentation and trial and error has proved fruitless.
Code excerpt:
Public Sub SortRecipients()
With Application.ActiveInspector
If TypeOf .CurrentItem Is Outlook.MailItem Then
Debug.Print "Before: "
Debug.Print "To: " & .CurrentItem.To
Debug.Print "# of recipients: " & .CurrentItem.Recipients.Count
' Force an update if recipients have changed (DOESN'T HELP)
.CurrentItem.Recipients.ResolveAll
Set myRecipients = .CurrentItem.Recipients
' Create objects for To list
Dim myRecipient As recipient
Dim recipientToList As Object
Set recipientToList = CreateObject("System.Collections.ArrayList")
' Create new lists from To line
For Each myRecipient In myRecipients
recipientToList.Add myRecipient.Name
Next
' Sort the recipient lists
recipientToList.Sort
' Remove all recipients so we can re-add in the correct order
While myRecipients.Count > 0
myRecipients.Remove 1
Wend
' Create new To line
Dim recipientName As Variant
For Each recipientName In recipientToList
myRecipients.Add (recipientName)
Next recipientName
.CurrentItem.Recipients.ResolveAll
End If
End With
End Sub
Steps to reproduce:
Add 4 recipients to the "To" line of a new email in Outlook 2007 (click "Check Names" to resolve the addresses.)
Run the SortRecipients macro. (Recipients are now sorted)
Delete one recipient, re-run the SortRecipients macro.
After doing this, I still have 4 recipients (the deleted one returns).
You can (and should) add an Option Explicit, Outlook would have told you that myRecipients was not declared at the begining of your code.
I added:
Dim myRecipients As Recipients
[EDIT] That wasn't enough to get the To field refreshed. I tried several things but eventually, i added a .CurrentItem.Save instead of your try of .CurrentItem.Recipients.ResolveAll
I think i made it work this way on my Outlook 2007.
Related
I aim to add an attachment to every item that is currently selected in Outlook 2016. My idea is to call Attachments.Add in a loop on each item in the current selection.
In my Drafts folder, I have three drafts with the subjects:
Draft Test 3
Draft Test 2
Draft Test 1
Because of the environment that I am in, I cannot use C#. I am using VBA instead. I ran all the test code by clicking Developer > Macros > [sub name] in the Outlook 2016 ribbon.
I started with this:
Sub AddTestTxtToSelection1()
Dim i As Long
With Application.ActiveExplorer.Selection
For i = .Count To 1 Step -1
.Item(i).Attachments.Add "C:\Full\Path\To\Test.txt", olByValue, 1
Next
End With
End Sub
Unfortunately, Test.txt was only attached to Draft Test 3 although all three drafts were selected. I thought that I might be iterating through the selection incorrectly, so I tried this:
Sub AddTestTxtToSelection2()
For Each objMessage In Application.ActiveExplorer.Selection
objMessage.Attachments.Add "C:\Full\Path\To\Test.txt", olByValue, 1
Next
End Sub
Again, although all three drafts were selected, Test.txt was only attached to Draft Test 3. In the example code in this article, Application.ActiveExplorer and its Selection property are stored in separate variables. I thought that that might have been what was missing, so I wrote this:
Sub AddTestTxtToSelection3()
Dim myOlExp As Explorer
Dim myOlSel As Selection
Set myOlExp = Application.ActiveExplorer
Set myOlSel = myOlExp.Selection
Dim i As Long
For i = 1 To myOlSel.Count
myOlSel.Item(i).Attachments.Add "C:\Full\Path\To\Test.txt", olByValue, 1
Next
End Sub
The behavior was identical to that of the first two tests. Finally, it occurred to me that the problem might be with modifying the drafts as I was looping over them. I then wrote this code, which stores the EntryID properties of the selected items in a separate string array before looping over them:
Sub AddTestTxtToSelection4()
Dim i As Long
Dim strEntryID As Variant
Dim namespaceMAPI As NameSpace
Dim objMessage As Object
Dim selected() As String
' Copy the current selection into an array of EntryID strings.
ReDim selected(1 To Application.ActiveExplorer.Selection.Count) As String
For i = 1 To Application.ActiveExplorer.Selection.Count
selected(i) = Application.ActiveExplorer.Selection.Item(i).EntryID
Next
' Retrieve each item from its EntryID string.
Set namespaceMAPI = Application.GetNamespace("MAPI")
namespaceMAPI.Logon
For Each strEntryID In selected
Set objMessage = namespaceMAPI.GetItemFromID(strEntryID)
objMessage.Attachments.Add "C:\Full\Path\To\Test.txt", olByValue, 1
Next
End Sub
Again, only Draft Test 3 had Test.txt attached after running this code. I thought that Outlook might be having trouble attaching the same file to multiple drafts, so I modified the last test to attach a different file to each draft. Only Draft Test 3 had an attachment after it was executed. Even if I swap out Application.ActiveExplorer.Selection for Application.ActiveExplorer.CurrentFolder.Items, still only the first draft gets an attachment.
Why can't Outlook attach a file to more than one mail item at a time? Is there a workaround?
Certain actions require a .Save.
There is likely a correlation with actions that require a save when done manually. In this case if you were to manually attach a file then close the draft you would be asked if the draft should be saved.
I have accepted #niton's answer, but here is my code after adding .Save:
' Based on AddTestTxtToSelection2
Sub AddTestTxtToSelection5()
For Each objMessage In Application.ActiveExplorer.Selection
objMessage.Attachments.Add "C:\Full\Path\To\Test.txt", olByValue, 1
objMessage.Save ' This line was added.
Next
End Sub
The attachments get added to every selected message now.
My client service system sends email notifications when a new inquiry comes in. I am able to reply to the notification and the system will update the inquiry with information from my email reply.
Reply example:
To: "client inquiry system"
Subject: Re: I am having password trouble Inquiry:5601
Body of email below:
Your password has been reset.
The above will append "Your password has been reset." to the inquiries description.
I am also able to trigger changes to Status ( i.e. Closed, Resolved, Defunct) if I place special syntax at the top of the email body.
To: "client inquiry system"
Subject: Re: Inquiry:5601 -- I am having password trouble
Body of email below:
Status=Closed
Your password has been reset.
The above will set the inquiry to Closed in my system.
I would like to use a form or macro button that will provide users with drop down selections or free form text that will be added to the top of the email body once set.
I have some familiarity with VBA, but very new. Please help!
I am not convinced by your reply to my comment but this answer is an attempt to be helpful. It includes four macros that demonstrate functionality you will need. I hope it is enough to get you started.
When you open Outlook’s Visual Basic Editor, you will see something like the following down the left side of the screen. If you do not see it, click Ctrl+R.
- Project 1 (VbaProject.OTM)
- Microsoft Office Outlook Objects
ThisOutlookSession
- Modules
Module1
The hyphens will be in little boxes. If any hyphen is a plus, click the plus to expand the list under the heading.
Click ThisOutlookSession. You will get an empty code area on the right. This is like a module code area but is used for event routines. Copy this code into that area:
Option Explicit
Public WithEvents MyNewItems As Outlook.Items
Private Sub Application_Startup()
' This event routine is called when Outlook is started
Dim NS As NameSpace
Dim UserName As String
Set NS = CreateObject("Outlook.Application").GetNamespace("MAPI")
With NS
UserName = .CurrentUser
Set MyNewItems = .GetDefaultFolder(olFolderInbox).Items
End With
MsgBox "Welcome " & UserName
End Sub
Private Sub myNewItems_ItemAdd(ByVal Item As Object)
' This event routine is called each time an item is added to Inbox
' because of:
' Public WithEvents MyNewItems As Outlook.Items
' Set MyNewItems = .GetDefaultFolder(olFolderInbox).Items
With Item
Debug.Print "#####" & Format(Now(), "dMmmyy hh:mm:ss") & _
": Item added to Inbox with Subject: [" & .Subject & _
"] from [" & .SenderEmailAddress & "] with Text body"
Debug.Print .Body
End With
End Sub
Close Outlook and click Yes for “Do you want to save the VBA project ‘VbaProject.OTM?’”
Reopen Outlook. You will be told a program is trying to access email addresses. Click Allow access for, select 10 minutes and click Yes. You will get a window saying “Welcome John Doe”.
If this does not happen, select Tools then Macros then Security. Security level Medium must be selected to use macros safely.
The macro Application_Startup() has accessed Outlook’s email database. It is not easy to avoid the user being asked to allow access since Outlook has a very robust security system. There is a four step self-certification process which should allow you suppress this question for your own macros. I have successfully performed the first three steps but have never mastered the fourth step. I have carefully followed such instructions as I can find on the web but nothing has worked for me. Perhaps you will be more successful or perhaps you have access to an expert who can guide you if you want to suppress this question
The macro Application_Startup() has done two things: issued the welcome message and initialised MyNewItems. The welcome message is just a demonstration that you can access the user’s name which might be useful if you have a shared Inbox. Initialising MyNewItems activates the event routine myNewItems_ItemAdd(). This outputs details of the each new item to the Immediate Window.
This is a quick demonstration of event routines which I thought would be useful to you. However, I have discovered that if myNewItems_ItemAdd() is busy with one item when a second arrives, it is not called for the second item. I use a very old version of Outlook and this may be a bug that has been cleared in later releases. If you decide to use event routines, you need to check this out.
Another way of getting access to emails is Explorer. Insert a new module and copy the following code into it:
Option Explicit
Public Sub DemoExplorer()
Dim Exp As Outlook.Explorer
Dim ItemCrnt As MailItem
Dim NumSelected As Long
Set Exp = Outlook.Application.ActiveExplorer
NumSelected = Exp.Selection.Count
If NumSelected = 0 Then
Debug.Print "No emails selected"
Else
For Each ItemCrnt In Exp.Selection
With ItemCrnt
Debug.Print "From " & .SenderName & " Subject " & .Subject
End With
Next
End If
End Sub
DemoExplorer() shows another way of giving a macro access to mail items. The user selects one or more emails and then activates the macro DemoExplorer(). Again this just outputs some properties of a mail item to the Immediate Window.
Click F2 and the code window is replaced by a list of libraries. Scroll down the list of Classes and select MailItem. The right hand window displays all the members of MailItem. Some, such as ReceivedTime, are obvious but you will probably have to look up most. I suggest you make a note of all that look useful. Click a module, to get back to a code window when you have finished.
DemoReply(), below, is an updated version of DemoExplorer() which replies to selected emails. Add this code to your module:
Public Sub DemoReply()
Dim Exp As Outlook.Explorer
Dim ItemCrnt As MailItem
Dim Reply As MailItem
Dim Subject As String
Dim SenderAddr As String
Dim Received As Date
Set Exp = Outlook.Application.ActiveExplorer
If Exp.Selection.Count = 0 Then
Debug.Print "No emails selected"
Else
For Each ItemCrnt In Exp.Selection
' Get properties of message received
With ItemCrnt
Subject = .Subject
SenderAddr = .SenderEmailAddress
Received = .ReceivedTime
End With
' Create reply
Set Reply = CreateItem(olMailItem)
With Reply
.BodyFormat = olFormatPlain
.Body = "Thank you for your enquiry" & vbLf & _
" Subject: " & Subject & vbLf & _
" Received at: " & Format(Received, "d Mmm yyyy h:mm:ss") & vbLf & _
"which will be handled as soon as an analyst is available."
.Subject = "Thank you for your enquiry"
.Recipients.Add SenderAddr
' Display allows the user to review the reply before it is written to Outbox
' but control is not returned to this macro. Only the first select mail item
' will be processed
' Send gives the user no opportunity to review the replies but the macro does not
' use control so all replies are sent.
'.Display
.Send
End With
Next
End If
End Sub
I use an Outlook address for my private email and a Gmail address for my public email. I sent myself some text emails from the Gmail address. In Outlook, I selected these emails and activated DemoReply(). The expected replies arrived in my Gmail Inbox. Try sending yourself some emails and the try replying.
To demonstrate the use of a useform within Outlook, I inserted a new form and left the name as the default UserForm1. I dragged two text boxes to the form which I left with their default names of TextBox1 and TextBox2. I also dragged a command button which I renamed cmdSend.
An Outlook macro can only communicate with a user form via global variables. Add the following at the top of the module; they must be placed before any macros:
Public Box1 As String
Public Box2 As String
Add this macro to the module:
Sub DemoForm()
' Initialise global variables to be used by form before it is loaded
Box1 = "Initial value for text box1"
Box2 = "Initial value for text box2"
Load UserForm1
UserForm1.Show vbModal
' Control does not return to this module until user releases control of form
Debug.Print Box1
Debug.Print Box2
End Sub
Add this code to the form:
Private Sub cmdSend_Click()
Box1 = TextBox1
Box2 = TextBox2
Unload Me
End Sub
Private Sub UserForm_Initialize()
TextBox1 = Box1
TextBox2 = Box2
End Sub
Activate DemoForm(). The form will appear with the text boxes set to "Initial value for text box1" and "Initial value for text box2". Change these values and click Send. Control will be returned to DemoForm() which outputs the new values to the Immediate Window.
I am trying to get this code to work.
I want to select multiple emails from my inbox and send a auto reply using a template.
I am getting a run-time error: Object variable or With Block variable not set.
Any help would be appreciated. Also I would like to add a msg box telling me how many items were sent.
Option Explicit
Sub ReplywithTemplate()
Dim Item As Outlook.MailItem
Dim oRespond As Outlook.MailItem
For Each Item In ActiveExplorer.Selection
' This sends a response back using a template
Set oRespond = Application.CreateItemFromTemplate("C:\Users\Accounting\AppData\Roaming\Microsoft\Templates\scautoreply.oft")
With oRespond
.Recipients.Add Item.SenderEmailAddress
.Subject = Item.Subject
' includes the original message as an attachment
.Attachments.Add Item
' use this for testing, change to .send once you have it working as desired
.Display
End With
On Error Resume Next
Next
Set oRespond = Nothing
End Sub
I have noticed the following lines of code:
For Each oRespond In ActiveExplorer.Selection
' This sends a response back using a template
Set oRespond = Application.CreateItemFromTemplate("C:\Users\Accounting\AppData\Roaming\Microsoft\Templates\scautoreply.oft")
With oRespond
You need to use a new variable for creating an auto-reply email from a template because the selected Outlook item is missed (replaced with a newly created one).
So, basically you can create an item from a template, add recipients from the selected Outlook item and call the Send method. Or you can use the Reply method of the selected item in Outlook, copy the required properties from a template and call the Send method. It is up to you which way is to choose.
Finally, you may find the Getting Started with VBA in Outlook 2010 article helpful.
I have a set of macros that have worked in Outlook 2003, 2007, and 2010. In fact, it still works in 2013 except in a specific case.
The macro brings up a dialog box whenever you try to send an email - to tag the subject line with key words. The problem is, if I just started Outlook, and I bring up a new email or reply - the default in Outlook 2013 is to bring it into the former "Reading Pane" rather than in a new window. If I do not hit "Pop Out" and I try to send, my macro crashes with this error:
"Run-time error '91' Object variable or with block variable not set"
I tried to check for loading the form first - but it seem ANY call to my userform, even userform.show, generates this error.
Oddly, if I remember to "Pop Out" my first email, it runs fine everytime after until I close/reopen Outlook. Even if I don't "Pop Out" other emails. It's only on the very first one that this occurs.
Here's the beginning of my Initialize Event:
Dim Tags() As String
Dim T As Variant
Dim PC As Variant
Dim Rent As String
Dim Child As String
Dim nsourcefile As Integer
Dim email As MailItem
Dim PD As Variant
Dim Proj As String
Dim Desc As String
'Set email = Application.ActiveInspector.CurrentItem
Set email = Application.ActiveExplorer.Selection.Item(1)
'Checks to see if a project number (that's not on the list) may be in the subject already
If Val(email.Subject) > 10000 Then
TagMsg.Height = tall
TagMsg.NewProjID = Format(Val(email.Subject), "00000")
TagMsg.NewProjDesc.SetFocus
Else
'Set height of form (prior to pressing "More" button
TagMsg.Height = short
End If
Noticed I changed Set email = Application.ActiveInspector.CurrentItem to Set email = Application.ActiveExplorer.Selection.Item(1). This seems to have fixed it, but the VBA help states "Do not make any assumptions about the Item method return type; your code should be able to handle multiple item types or a ConversationHeader object."
Note that the form is being invoked by the ItemSend event.
First off, putting that code into the Initialize event wasn't a good move. Needed to be moved into a click event where it was actually needed.
Then, I found the code I needed from two other posts, combined and shortened them.
Working with current open email
https://superuser.com/questions/795831/outlook-2013-vba-refer-to-editor-in-reading-pane
Final result
Dim oInspector As Inspector
Dim email As MailItem
Dim oexp As Explorer
Set oInspector = Application.ActiveInspector
Set oexp = Application.ActiveExplorer
If oInspector Is Nothing Then
'Set email = Application.ActiveExplorer.Selection.Item(1)
Set email = oexp.ActiveInlineResponse
If email Is Nothing Then
'MsgBox "No active inspector or inline response"
Exit Sub
End If
Else
Set email = oInspector.CurrentItem
End If 'oInspector is Nothing
If email.Sent Then
'MsgBox "This is not an editable email"
Else
'Checks to see if a project number (that's not on the list) may be in the subject already
If Val(email.Subject) > 10000 Then
TagMsg.Height = tall
TagMsg.NewProjID = Format(Val(email.Subject), "00000")
TagMsg.NewProjDesc.SetFocus
Else
'Set height of form (prior to pressing "More" button
TagMsg.Height = short
End If
End If 'email.sent
Note: This still relies on the fact that it is called by the ItemSend event and the active or current item will be the email I just pressed "send" on.
Thank you, retailcoder for your comments.
Can anyone help me figure out what's going wrong and how to fix it?
I'm trying to automate sending an email with some daily status information. I'd tried automating this from Access but kept running into (known but apparently unsolved) problems with GetObject(, "Outlook.Application") with Windows 8.1 64 and Outlook 2013. So I decided to automate starting from Outlook.
Anyway, I moved the mail message creation code into Outlook vba and had it start Access and run the Access code. This is all well and good until I get to creating the mail message. Everything starts just fine until it gets to writing to the body of message (using Word as the body editor). At the first "TypeText" command, I'm getting the error message in the title. If I click debug on the error notification dialog and then single-step through the line of code in question, it works just fine. I thought that there was some timing problem, so I stuck a 2-second wait in the code. No luck. The code in question, with some other oddities associated with testing (notably trying to type and then delete text), is below:
Public Sub CreateMetrics()
' Mail-sending variables
Dim mailApp As Outlook.Application
Dim accessApp As Access.Application
Dim mail As MailItem
Dim wEditor As Word.Document
Dim boolCreatedApp As Boolean
Dim i As Integer
Set mailApp = Application
' Create an Access application object and open the database
Set accessApp = CreateObject("Access.Application")
accessApp.OpenCurrentDatabase dbLoc
accessApp.Visible = True
' Open the desired form and run the click event hander for the start button
accessApp.DoCmd.OpenForm ("ProcessStatus")
accessApp.Forms![ProcessStatus].StartButton_Click
' Create the outgoing mail message
Set mail = Application.CreateItem(olMailItem)
mail.Display
mail.BodyFormat = olFormatHTML
Set wEditor = mailApp.ActiveInspector.WordEditor
With accessApp.Forms![ProcessStatus]
Debug.Print .lblToList.Caption
Debug.Print .lblSubject.Caption
Debug.Print .lblIntroduction.Caption
Debug.Print .lblAttachFilepath.Caption
End With
mail.To = accessApp.Forms![ProcessStatus].lblToList.Caption
mail.Recipients.ResolveAll
mail.Subject = accessApp.Forms![ProcessStatus].lblSubject.Caption
mail.Attachments.Add accessApp.Forms![ProcessStatus].lblAttachFilepath.Caption
Sleep 2000
' Error occurs in the next line ***********************************************
wEditor.Application.Selection.TypeText Text:="Test"
wEditor.Application.Selection.HomeKey
wEditor.Application.Selection.Delete Count:=4
wEditor.Application.Selection.PasteSpecial DataType:=wdPasteBitmap
wEditor.Application.Selection.HomeKey
wEditor.Application.Selection.TypeText accessApp.Forms![ProcessStatus].lblIntroduction.Caption
wEditor.Application.Selection.TypeText Text:=Chr(13) & Chr(13)
wEditor.Application.Selection.EndKey
' wEditor.Application.Selection.EndKey
' wEditor.Application.Selection.TypeText Text:=Chr(13)
' wEditor.Application.Selection.TypeText Text:=configs("EmailSignature")
' End With
With mailApp.Session.Accounts
i = 1
Do While i <= .Count
' Use either the specified email address OR the last outlook email address
If RegEx_IsStringMatching(.Item(i).SmtpAddress, accessApp.Forms![ProcessStatus].lblSenderRegex.Caption) Or i = .Count Then
mail.SendUsingAccount = .Item(i)
i = .Count + 1
Else
i = i + 1
End If
Loop
End With
mail.Save
accessApp.Quit
End Sub
I added a "mail.Display" just before the line that was causing the failure, which seemed, incorrectly, to have fixed the problem.
I have now solved this problem by executing a document.select on the document associated with the email I was creating. To select the right document (there doesn't seem to be any guarantee of which one that would be within the wEditor.Application.Documents collection, though it was typically the first one), I created an almost-certainly unique piece of text and assigned it to the body of the email, which I could then go and find. Here's the new code that I added to the code above:
Dim aDoc As Word.Document
Dim strUniqueID As String
. . .
mail.Attachments.Add accessApp.Forms![ProcessStatus].lblAttachFilepath.Caption
strUniqueID = accessApp.Forms![ProcessStatus].lblSubject.Caption & Rnd(Now()) & Now()
mail.Body = strUniqueID
' Search for the unique text. aDoc.Content has extra characters at the
' end, so compare only for the length of the unique text
For Each aDoc In wEditor.Application.Documents
If Left(aDoc.Content, Len(strUniqueID)) = strUniqueID Then
aDoc.Select
mail.Body = ""
End If
Next aDoc
wEditor.Application.Selection.TypeText Text:="Test"
. . .
I looked at a lot of examples of code that did this kind of thing. None of them performed a select or said anything about needing one. Debugging was made that much harder because the select occured implicitly when the debugger was invoked.