I'm building a macro that will run automatically when I move into the body of an email to check the email address of the recipient.
I cannot get the address of the recipient to load into a variable.
Sub BuildTable()
Dim myItem As Outlook.MailItem
Dim myRecipient As String
Set myItem = Application.CreateItem(olMailItem)
Set myRecipient = myItem.Recipient.Address
....
It seems that you are running in MS Outlook and in an Active Inspector, so perhaps:
Sub CheckAddresses()
Dim oEmail As Outlook.MailItem
Dim r As Recipient
Dim rList As Recipients
Set oEmail = Application.ActiveInspector.CurrentItem
Set rList = oEmail.Recipients
rList.ResolveAll
For Each r In rList
Debug.Print r.Address
Next
End Sub
I'm not sure what version of Outlook you are using, but according to Microsoft (http://msdn.microsoft.com/en-us/library/office/aa211006(v=office.11).aspx) you need to use the .Recipients(Index) to get a Recipient. From there you may be able to get the address. I also saw mention of some sort of ResolveAll method attached to .Recipients, though that referenced Outlook 2000 (eww).
Try doing
Dim myItem As Outlook.MailItem
Dim myRecipient as String
Set myItem = Application.CreateItem(olMailItem)
Set myRecipient = myItem.Recipients.Item(0).Address
This will give you the address of the first recipient (note I can't remember if VBA starts at index 0 or 1, if you get IndexOutOfRange, change to 1). If you need others, you're going to need to do a loop. Something like this:
For Each Recipient in myItem.Recipients
// do some stuff here
Next Recipient
Hope this helps.
This is what this segment of code ended up looking like:
Sub BuildTable1()
Dim oEmail As Outlook.MailItem
Set oEmail = Application.ActiveInspector.currentItem
Set xlApp = CreateObject("Excel.Application")
xlApp.Application.Visible = True
xlApp.workbooks.Open FileName:= file location
xlApp.WorkSheets("Contacts").Activate
xlApp.Range("A6").Value = oEmail.To
//filtering by value, copying, pasting, etc.
End Sub
-ZL
Related
Daily I receive tons of emails, maximum of which needs to be worked upon and some are follow up emails.
I am using the flagged mode to track the important emails and replying them and simultaneously clearing the flags, and sometimes I forget hence I have to go to the sent item and search by email's subject line and take action accordingly.
I am looking for a code which will help me in:-
1.Macro will iterate through all the flagged emails in inbox.
2.Then it will check the sent on time (received time of the email in inbox)
3.Thereafter it will check the sent items whether the email has been replied (re: Subject) or forwarded (fw:subject) and with the senton time.
4.If the sent time is more than > received time (of the flagged emails) then msgbox:- Email has been replied
otherwise it will pop up a msgbox:- Email has not been replied, do you want to reply?, if yes, then it will reply the existing email with write function.
I do have written a code,it is working but I am not getting any response, nor pop up emails nor any bug fixing pop ups.your response will be highly appreciated :-
Sub trial()
On Error Resume Next
Dim objfolder As Outlook.MAPIFolder
Dim objfolder2 As Outlook.MAPIFolder
Dim objfolder2 As Outlook.MAPIFolder
Dim objfolder1 As Outlook.MAPIFolder
Dim objns As Outlook.NameSpace`Dim objitem As Outlook.MailItem`
Dim objitem1 As Outlook.MailItem
Dim objvariant As Variant
Dim objvariant1 As Variant
Dim obsubject As Variant
Dim obsubject1 As Variant
Dim sendtime As Variant
Dim sendtime1 As Variant
Dim obfollowupmail As Outlook.MailItem
Dim strpromt As Variant
Dim nresponse As Integer
Set objns = Outlook.GetNamespace("MAPI")
'declaring inbox
Set objinbox = objns.GetDefaultFolder(olFolderInbox)
'declaring sent
Set objfolder1 = objns.GetDefaultFolder(olFolderSentMail)
For Each objitem In objinbox
If objinbox.DefaultItemType = olMailItem Then
If objitem.Class = olMail Then
If objitem = IsMarkedAsTask Then
Set objvaraiant = objinbox.Items
Set obsubject = LCase(objvariant.Subject)
Set sendtime = objvariant.SentOn
obsubject1 = "re: &subject"
For Each obsubject1 In objfolder1
Set objvariant1 = objfolder1.Items
Set sendtime1 = obsubject1.SentOn
If sendtime1 > sendtime Then
MsgBox ("Message has been replied for" & obsubject)
Else
strpromt = "you haven't received the reply of" & obsubject
nresponse = MsgBox(vbYesNo + vbQuestion, "Confirm to send a follow up email?")
If nresponse = vbYes Then
Set obfollowupmail = Application.CreateItem(olMailItem)
With obfollowupmail
.Display
Set objitem = Nothing
Set obfolder = Nothing
Set objinbox = Nothing
Set objns = Nothing
End With
End If
End If
Next
End If
End If
End If
Next
End Sub
I need to be able to send an email from VBA from a different email address. I have permissions to send from that address and can select it manually from the Outlook Message window. However, there is no index to it when I run the following code. All that shows up is my email address.
Sub Which_Account_Number()
'Don't forget to set a reference to Outlook in the VBA editor
Dim OutApp As Object
Dim I As Long
Set OutApp = CreateObject("Outlook.Application")
For I = 1 To OutApp.Session.Accounts.Count
MsgBox OutApp.Session.Accounts.Item(I) & " : This is account number " & I
Next I
End Sub
Is there a way to use the actual email address in the call? This is my test code for what I am trying to accomplish:
Sub SendMessagesTest()
Dim objOutlook As Object ' Outlook.Application
Dim objOutlookMsg As Object ' Outlook.MailItem
Dim objOutlookRecip As Object ' Outlook.Recipient
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
objOutlook.Session.Logon
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(0) '0 = olMailItem
With objOutlookMsg
' Set the Subject & Body of the message.
.Subject = "Test Subject"
.Body = "Test Body"
'.BodyFormat = 3 '3 = olFormatRichText (Late Binding)
'Change Item(1)to another number to use another account
Set .SendUsingAccount = "TestUser#test.com" 'objOutlook.Session.Accounts.Item(2) ' (Late Binding)
.Display
End With
Set objOutlook = Nothing
Set objOutlookMsg = Nothing
Set objOutlookRecip = Nothing
Exit Sub
End Sub
When I run it I get the error "Object Required".
I cannot use this type of code because I do not have an index number to use for the email address:
Set .SendUsingAccount = objOutlook.Session.Accounts.Item(1)
Edit: This is the code that I use to add an appointment item to another user's calendars which have been shared with me. Note: I have Publishing Editor permissions on the mailbox I am trying to Send As.
Sub CreateCalendarApptx()
Dim objApp As Object
Dim objNS As Object
Dim objFolder As Object
Dim objRecip As Object
Dim objAppt As Object
Dim objMsg As Object
Const olMailItem = 0
Const olFolderCalendar = 9
Dim strName As String
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.getNamespace("MAPI")
Set objMsg = objApp.CreateItem(olMailItem)
strName = "OtherUser#Test.com"
'Select Calendar on which to place the appointment
'The Calendar can either be set with the name of the calendar or the Folder ID
If Left(strName, 3) = "ID:" Then
'Strip out the ID: identifier and leave just the ID
strName = Mid(strName, 5, Len(strName))
Set objFolder = objNS.GetFolderFromID(strName)
Else
Set objRecip = objMsg.Recipients.Add(strName)
objRecip.Resolve
If objRecip.Resolved Then
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
End If
End If
Set objAppt = objFolder.Items.Add
objAppt.Subject = "Test"
objAppt.Display
Set objApp = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set objMsg = Nothing
Set objRecip = Nothing
Set objAppt = Nothing
End Sub
Edit 2:
I added another comment earlier, but the board didn't seem to like it because I attached a picture. The upshot is that when I send an email from the Outlook interface with a different name in the From: field, it sends successfully. However, when I hover over it I see "From: OtherUser#test.com Send Using Account: Me#test.com" If that is the case, the SendUsingAccount in VBA would be my email address, and there should be another property that would be the From: field.
change your statement from:
Set .SendUsingAccount = objOutlook.Session.Accounts.Item(1)
to:
Set .SendUsingAccount = objOutlook.Session.Accounts.Item("Testuser#test.com")
I was able to get SendUsingAccount to work -- except that items sat in the other account's Outbox and never were sent.
I finally got it to work by creating a mail profile that had the account I wanted to send as from as the only account. Then I added my mail account but left the SendUsingAccount as the default account for the profile to use. That way it continued to work.
But that's a bit inconvenient, except in my case the computer running the software is not my primary computer, so having the default profile set to a mail account other than mine will be bearable.
Are you sending on behalf of a delegate Exchange mailbox? Set the MailItem.SentOnBehalfOfName property.
Re: Comment to other answer post. It is unusual to do this "I can set appointments on other people's calendars from VBA".
If you have such rights, to the inbox of the other mailbox, you may be able to do this.
Option Explicit
Sub SendMailFromNonDefaultAccount()
' The only way I know this works is to
' use the "Add Account" button to add a non-default account.
' Not "Account Settings" which adds a mailbox to the default Account.
Dim myRecipient As recipient
Dim nonDefaultInboxFolder As Folder
Dim addMail As MailItem
' This is where your unusual permission, without adding an account, might yet kick in
Set myRecipient = Session.CreateRecipient("non-default email address as a string inside quotes")
Set nonDefaultInboxFolder = Session.GetSharedDefaultFolder(myRecipient, olFolderInbox)
' Add, not create, in non-default folder
Set addMail = nonDefaultInboxFolder.Items.Add
' The non-default email address will be in the "From"
addMail.Display
End Sub
With the code for the shared calendar applied to the shared inbox.
Option Explicit
Sub CreateCalendarAppt_and_mail()
Dim objApp As Object
Dim objNS As Object
Dim objFolder As Object
Dim objRecip As Object
Dim objAppt As Object
Dim objMsg As Object
Dim objInboxShared As Object
Dim objMsgShared As Object
' If there is no reference to the Outlook Object Library
Const olFolderInbox = 6
Const olMailItem = 0
Const olFolderCalendar = 9
Dim strName As String
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objMsg = objApp.CreateItem(olMailItem)
strName = "OtherUser#Test.com"
Debug.Print strName
Set objRecip = objMsg.Recipients.Add(strName)
objRecip.Resolve
If objRecip.Resolved Then
Set objFolder = objNS.GetSharedDefaultFolder(objRecip, olFolderCalendar)
Set objAppt = objFolder.Items.Add
objAppt.Subject = "Test"
objAppt.Display
' Follows the format of the calendar code
' Looks the same as my original code
Set objInboxShared = objNS.GetSharedDefaultFolder(objRecip, olFolderInbox)
' objInboxShared.Display
Set objMsgShared = objInboxShared.Items.Add
objMsgShared.Subject = "Test Message"
objMsgShared.Display
End If
Set objApp = Nothing
Set objNS = Nothing
Set objFolder = Nothing
Set objMsg = Nothing
Set objRecip = Nothing
Set objAppt = Nothing
Set objInboxShared = Nothing
Set objMsgShared = Nothing
End Sub
I had two machines that were experiencing this same problem.
With the first machine, the user was being prompted to select a profile on opening Outlook. By setting the Control Panel/Mail profile setting so that it "Always use this profile", the problem was fixed.
The second machone had two profiles. Even though the main one was selected to "always use this profile", it still had the same problem. By removing the second profile, the problem went away.
Summary
I'm trying to add hyperlinks to tasks created from emails that I have moved to another folder.
The goal is to have the task contain a hyperlink to the Outlook item that was moved to a "Processed Email" folder".
Problem
I don't understand how to move a MailItem and then get its new EntryID after it moves.
The "naive" way doesn't work. After using the Move method to move a MailItem object, the EntryID property does not reflect a change in ID.
Details
Creating a hyperlink to an Outlook item using the format outlook:<EntryID> is easy enough if the Outlook item remains in the Inbox, since I can just get the EntryID of the object that I am linking to. However, Outlook changes the EntryID when an object is moved.
I want to understand how to get the updated ID so that I can construct an accurate link.
Example
The message boxes show the EntryID property of objMail returns the same value despite the fact that the object has moved. However, running a separate macro on the mail in the destination folder confirms that the EntryID has changed with the move.
Sub MoveObject(objItem As Object)
Select Case objItem.Class
Case olMail
Dim objMail As MailItem
Set objMail = objItem
MsgBox (objMail.EntryID)
Dim inBox As Outlook.MAPIFolder
Set inBox = Application.ActiveExplorer().Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
Dim destFolder As Outlook.MAPIFolder
Set destFolder = inBox.Folders("Processed Email")
If (Application.ActiveExplorer().CurrentFolder.Name <> destFolder.Name) Then
objMail.Move destFolder
End If
MsgBox (objMail.EntryID)
End Select
End Sub
The Move method of the MailItem class returns an object that represents the item which has been moved to the designated folder. You need to check out the EntryID value of the returned object, not the source one.
Anyway, you may consider handling the ItemAdd event of the target folder to make sure that an updated entry ID value is used all the time.
Sub MoveItems()
Dim myNameSpace As Outlook.NameSpace
Dim myInbox As Outlook.Folder
Dim myDestFolder As Outlook.Folder
Dim myItems As Outlook.Items
Dim myItem As Object
Set myNameSpace = Application.GetNamespace("MAPI")
Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox)
Set myItems = myInbox.Items
Set myDestFolder = myInbox.Folders("Personal Mail")
Set myItem = myItems.Find("[SenderName] = 'Eugene Astafiev'")
While TypeName(myItem) <> "Nothing"
myItem.Move myDestFolder
Set myItem = myItems.FindNext
Wend
End Sub
Hello can you please elaborate your answer I am not able to understand it.
Anyway, you may consider handling the ItemAdd event of the target folder to make sure that an updated entry ID value is used all the time.
Here is my code and I need EntryID after moving.
Sub Movetest1()
Dim olApp As Outlook.Application
Dim olns As Outlook.NameSpace
Dim Fld As Folder
Dim ofSubO As Outlook.MAPIFolder
Dim myDestFolder As Outlook.Folder
Dim ofolders As Outlook.Folders
Dim objItems As Outlook.Items
Dim myRestrictItems As Outlook.Items
Dim i As Long
Dim myitem As Object
' Dim MailItem As Microsoft.Office.Interop.Outlook.MailItem
Dim MailItem, moveditem As Outlook.MailItem
Dim eid As String
Dim sid As Variant
Dim newEID As String
'---------------------------------------------------------------------------------------------------------
Set olApp = New Outlook.Application
Set olns = olApp.GetNamespace("MAPI")
For Each Fld In olns.Folders
If Fld.Name = "GSS Payables" Then
'
' MsgBox Fld.Name
' Debug.Print " - "; Fld.EntryID
Set Fld = olns.GetFolderFromID("000000009DA6D76FBE7A58489450CDF6094F592A0100A2457DC435B22448A832DB721D8185B1000000B6207D0000").Folders("Inbox")
Exit For
End If
Next
Set objItems = Fld.Items
eid = "000000009DA6D76FBE7A58489450CDF6094F592A0700A2457DC435B22448A832DB721D8185B1000000B620800000A2457DC435B22448A832DB721D8185B100007FF773270000"
sid = "000000009DA6D76FBE7A58489450CDF6094F592A0100A2457DC435B22448A832DB721D8185B1000000B6207D0000"
Set myDestFolder = Fld.Folders("Bhagyashri")
'Set myitem = objItems.Find("[SenderName]='Microsoft Outlook '")
Set MailItem = olns.GetItemFromID(eid)
Set moveditem = MailItem.Move(myDestFolder)
"giving error here
newID = moveditem.entryid
Debug.Print "newID -"; newID
' get mailitem.parent.storeid
MsgBox "done"
End
Use the following syntax:
Dim MoveToFolder As outlook.MAPIFolder
Dim MyItem As outlook.MailItem
Dim NewEntryID As String
NewEntryID = MyItem.Move(MoveToFolder).ENTRYID
After MyItem.Move is executed the new ENTRYID will be returned to the NewEntryID variable.
I'm looking to use the get function in vba in order to activate a specific email in Outlook and then copy the body into a new email and send. I can use the getlast function to get the latest email in the inbox, however I would like to refine the code some more by selecting the latest email from a specific email address.
Also, I'd love how to know how to delete the signature from the text pasted into the new email.
Sub Negotiations()
Dim objMsg As Outlook.MailItem
Dim objItem As Outlook.MailItem
Dim BodyText As Object
Dim myinspector As Outlook.Inspector
Dim myItem As Outlook.MailItem
Dim NewMail As MailItem, oInspector As Inspector
Set myItem = Application.Session.GetDefaultFolder(olFolderInbox).Items.GetLast
myItem.Display
'copy body of current item
Set activeMailMessage = ActiveInspector.CurrentItem
activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy
' Create the message.
Set objMsg = Application.CreateItem(olMailItem)
'paste body into new email
Set BodyText = objMsg.GetInspector.WordEditor.Range
BodyText.Paste
'set up and send notification email
With objMsg
.To = "#gmail.com"
.Subject = "Negotiations"
.HTMLBody = activeMailMessage.HTMLBody
.Display
End With
End Sub
any help would be appreciated, thank you guys!
Open the Inbox folder using Namespace.GetDefaultFolder(olFolderInbox), retrieve the Items collection from MAPIFolder.Items. Sort the items (Items.Sort) on the ReceivedTime property, retrieve the latest email using Items.Find on the SenderEmailAddress property.
Dependant on what your property of .SenderEmailAddress returns, you can adapt what the while statement evaluates for. This should work for you, by first looking at the last e-mail, and then checking each previous e-mail for the correct sender address.
Sub display_mail()
Dim outApp As Object, objOutlook As Object, objFolder As Object
Dim myItems As Object, myItem As Object
Dim strSenderName As String
Set outApp = CreateObject("Outlook.Application")
Set objOutlook = outApp.GetNamespace("MAPI")
Set objFolder = objOutlook.GetDefaultFolder(olFolderInbox)
Set myItems = objFolder.Items
strSenderName = UCase(InputBox("Enter the e-mail Alias."))
Set myItem = myItems.GetLast
While Right(myItem.SenderEmailAddress, Len(strSenderName)) <> strSenderName
Set myItem = myItems.GetPrevious
Wend
myItem.Display
End Sub
Application.Session.GetDefaultFolder(olFolderInbox).Items.GetLast
activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy
First of all, I'd recommend breaking the chain of calls. Declare each property or method call on a separate line of code, so you will be able to debug the code at any time and see what happens under the hood.
The GetLast method returns the last object in the collectio. But it doesn't mean that the item is recieved last. You need to sort the collection using the Sort method as Dmitry suggested passing the ReceivedTime property as a parameter to sort on. Only in that case you will get the last recieved item from the collection.
The Outlook object model doesn't provide any special method or property for identifying signatures. You need to parse the message body and find it programmatically.
Sub Nego()
Dim objMsg As Outlook.MailItem
Dim myItem As Outlook.MailItem
Dim BodyText As Object
Dim Inspector As Outlook.MailItem
Dim olNameSpace As Outlook.NameSpace
Dim olfolder As Outlook.MAPIFolder
Dim msgStr As String
Dim endStr As String
Dim endStrStart As Long
Dim endStrLen As Long
Dim myItems As Outlook.Items
'Access folder Nego
Const olFolderInbox = 6
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objInbox = objNamespace.GetDefaultFolder(olFolderInbox)
strFolderName = objInbox.Parent
Set objMailbox = objNamespace.Folders(strFolderName)
Set objFolder = objMailbox.Folders("Nego")
'Mark as read
For Each objMessage In objFolder.Items
objMessage.UnRead = False
Next
'Sort
Set myItems = objFolder.Items
For Each myItem In myItems
myItems.Sort "Received", False
Next myItem
myItems.GetLast.Display
'copy body of current item
Set activeMailMessage = ActiveInspector.CurrentItem
activeMailMessage.GetInspector().WordEditor.Range.FormattedText.Copy
' Create the message.
Set objMsg = Application.CreateItem(olMailItem)
'paste body into new email
Set BodyText = objMsg.GetInspector.WordEditor.Range
BodyText.Paste
'Search Body
Set activeMailMessage = ActiveInspector.CurrentItem
endStr = "first line of signature"
endStrLen = Len(endStr)
msgStr = activeMailMessage.HTMLBody
endStrStart = InStr(msgStr, endStr)
activeMailMessage.HTMLBody = Left(msgStr, endStrStart + endStrLen)
'set up and send email
With objMsg
.To = "#email"
.Subject = "Nego"
.HTMLBody = activeMailMessage.HTMLBody
.HTMLBody = Replace(.HTMLBody, "First line of signature", " ")
.Send
End With
End Sub
I am trying to create a macro that will take a column of email addresses from my Excel sheet and populate the "To" field in an Outlook email. I have the basics working, and I am able to create a new Outlook email message with the various field values I have specified - however, I cannot figure out how to populate multiple email addresses into the "To" field, for a single email.
As of right now, I am able to create an array with all of the desired email addresses, but can't figure out how to populate the array values into the Outlook "To" field.
This is based on Eugene's answer, edited to include the excel implementation
Sub CreateStatusReportToBoss(addRng as Excel.Range)
Dim myItem As Outlook.MailItem
Dim myRecipient As Outlook.Recipient
Set myItem = Application.CreateItem(olMailItem)
For Each cell in addRng
Set myRecipient = myItem.Recipients.Add(cell.Value)
Next cell
myItem.Subject = "Status Report"
myItem.Display
End Sub
You can use the Recipients property of the MailItem class for adding multiple recipients. It also allows to specify the type of the Recipient: To, CC or BCC.
Sub CreateStatusReportToBoss()
Dim myItem As Outlook.MailItem
Dim myRecipient As Outlook.Recipient
Set myItem = Application.CreateItem(olMailItem)
Set myRecipient = myItem.Recipients.Add("Dan Wilson")
myItem.Subject = "Status Report"
myItem.Display
End Sub
This might help but the concept is bit different as to the items. Hope this helps out- have used in the past for similar case but ofcourse, will only provide maproad.
Sub CreateMail()
Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngCc As Range
Dim rngSubject As Range
Dim rngBody As Range
Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With ActiveSheet
Set rngTo = .Range("B1")
Set rngCc = .Range("B2")
Set rngSubject = .Range("B3")
Set rngBody = .Range(.Range("B4"), .Range("B4").End(xlDown))
End With
rngBody.Copy
With objMail
.To = rngTo.Value
.Cc = rngCc.Value
.Subject = rngSubject.Value
.Display
End With
SendKeys "^({v})", True
Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngCc = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing
End Sub