Email From Contact of Calendar

[LMS]

Through all I have received, the following is the code that creates an email to a selected or opened or selected contacts individually using email template form, but when I open the contact from a calendar event, it does not recognize the email address of the contact, and it does not work. So what can we fix right away so when I open a contact from a calendar event or an email I received, this macro will create the email to the contact.

Sub Group_Email_Good_Afternoon()
Dim objApp As Application
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim objMsg As mailItem
Dim ObjItem As Object

Set oContact = ObjItem
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")

Set objSelection = objApp.ActiveExplorer.Selection

For Each ObjItem In objSelection


Set objMsg = Application.CreateItemFromTemplate("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\Form1.oft")
With objMsg

.To = ObjItem.Email1Address & ";" & ObjItem.Email2Address

objMsg.Display

End With
'objMsg.Send
Next
Set objMsg = Nothing
Set ObjItem = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Sub

 

[Diane Poremsky]

Do you have more than one contact in the appointment? AFAIK, you need to open the contact, not just select it, so you don't need the for each...

 

[LMS]

I open it and the code shows yellow collar on the email address line

 

[LMS]

And also, the code does not work when I select and open the contact from the email name of the person that sent the email...so the link is from the email I received...please let me know

 

[Diane Poremsky]

So you are only opening one contact?

 

[LMS]

Yes. Just opening one contact from an email or calendar event

 

[LMS]

Help today?

 

[Diane Poremsky]

If i get a chance - i need to boot up an old machine so i can test the code (in the other thread) that Michael said should work.

 

[LMS]

What code please?

 

[LMS]

Update please?

 

[Diane Poremsky]

You need the links collection if you are going to work with links. This should work - select or open the appointment and run it - it creates one message sent to all contacts in the contacts field. This uses the function here - http://www.slipstick.com/developer/outlook-vba-work-with-open-item-or-select-item/ - which i think you already have.

Sub GroupEmail()
Dim objMsg As MailItem
Dim objItem As Object
Dim colLinks As Links
  Dim i As Integer
  Dim strAddress As String
 
  Dim oRecip As Recipient
  Dim Recipients As Recipients
 
Set objItem = GetCurrentItem()

Set colLinks = objItem.Links
If colLinks.Count > 0 Then
For i = 1 To colLinks.Count
strAddress = colLinks.Item(i) & ";" & strAddress
Next
End If

Set objMsg = Application.CreateItem(olMailItem)
'Application.CreateItemFromTemplate("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\Form1.oft")

With objMsg

.To = strAddress

objMsg.Display
End With

For Each oRecip In objMsg.Recipients
oRecip.Resolve
Next

Set objMsg = Nothing
Set objItem = Nothing

End Sub

 

[Diane Poremsky]

Now, if you really want to send to the contact you opened from the field on the appointment, use this one. (It should work for any open contact. )

Sub MailtoOpenContact()
Dim objApp As Application
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim objMsg As MailItem
Dim ObjItem As Object

Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")

Set ObjItem = objApp.ActiveInspector.currentItem

Set objMsg = Application.CreateItem(olMailItem)
'Set objMsg = Application.CreateItemFromTemplate("C:\Users\UserName\AppData\Roaming\Microsoft\Templates\Form1.oft")

With objMsg
.To = ObjItem.Email1Address '& ";" & ObjItem.Email2Address
objMsg.Display

End With
Set objMsg = Nothing
Set ObjItem = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Sub

 

[LMS]

Does this work if I open a contact from the person that sends me an email...as I open the contact by clicking on the name of the sender...and my email macros to don't recognize the email address ..that's the error.

 

[Diane Poremsky]

The first works from the appointment - select the appointment, run the macro and the name(s) in the Contact field are added to an email message. The second one works from an opened contact - and yes, either opened from the contact field in an appointment or using the look up contact command in a message.

 

[LMS]

Set objMsg = Application.CreateItem(olMailItem)
'Set objMsg = Application.CreateItemFromTemplate("C:\Users\UserName\AppData\Roaming\Microsoft\Template.Form.oft


Which of these work re the opening the contact...as I want to user a template form...and that line looks like you stopped it

 

[LMS]

The following works perfect when I open the contact from the folder or from an email or from a calendar, but it does not work if I select two contacts from a folder or select the contact from the folder and not open it, which we did before. So what can I add to this so it works when I open the contact from the folder or from an email or from a calendar, or select one or more contact from a folder and not open it?

Sub MailtoOpenContact()
Dim objApp As Application
Dim objNS As NameSpace
Dim objFolder As MAPIFolder
Dim objMsg As mailItem
Dim objItem As Object
Set objApp = CreateObject("Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set objItem = objApp.ActiveInspector.currentItem
'Set objMsg = Application.CreateItem(olMailItem)
Set objMsg = Application.CreateItemFromTemplate("C:\Users\UserNameAppData\Roaming\Microsoft\Templates\TemplateName.oft")
With objMsg
.To = objItem.Email1Address & ";" & objItem.Email2Address
objMsg.Display
End With
Set objMsg = Nothing
Set objItem = Nothing
Set objFolder = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Sub

 

[Diane Poremsky]

Set objMsg = Application.CreateItem(olMailItem)
'Set objMsg = Application.CreateItemFromTemplate("C:\Users\UserName\AppData\Roaming\Microsoft\Template.Form.oft


Which of these work re the opening the contact...as I want to user a template form...and that line looks like you stopped it

Use your line - i used a blank form in my tests because I didn't have a template in that file path.

 

[LMS]

It worked great. Please see the last question I posted.

 

[Diane Poremsky]

Selecting two means you need to a loop. If you change this line: Set objItem = objApp.ActiveInspector.currentItem to Set objItem = GetCurrentItem() and use the GetCurrentItem function (which you should have, as you used it in earlier macros) it will work with open or selected items.


To change one or more, you need to use something like this

For Each obj In objItem
If obj.Class = olContact Then

Set objContact = obj


With objContact
' do whatever

end with

end if
next

 

[LMS]

Thanks very much. As usual, please give me the details of what I add and where to put it. And what do I delete? And does this then do it if I open a contact from a folder, calender or email sender, or select the contact or contacts but not open them? So it is one macro for all ways of using a contact?