Tag Archives: send mail

This simple macro, use the selection object of current window Application.ActiveExplorer.Selection and in case of a selection of contacts olContact ,
creates a blank message olMailItem and fill in the Bcc field: (BCC:) with 3 e-mail contact, also can use the To: field (To:), works in Outlook 2003, 2007, 2010….

Here: link you have more information to create a button and link the macro

Sub ContactsSelected_to_CCO()
Dim olkItm As Object, olkRcp As Outlook.Recipient, olkLst As Outlook.DistListItem
 Select Case TypeName(Application.ActiveWindow)
	Case "Explorer"
		Set olkItm = Application.ActiveExplorer.Selection(1)
End Select
If TypeName(olkItm) <> "Nothing" Then
	Select Case olkItm.Class
		'If	 the source item is a contact or list of contacts
		Case olContact
			'Create a new Mail
			Set olmail1 = Application.CreateItem(olMailItem)
			' variable to add email address
			msgtxt = ""
			With olmail1
				Set myOlSel = Application.ActiveExplorer.Selection
				' for each selected contact adds email
				' if email 2 or email 3 are filled , add to bcc too.
				For x = 1 To myOlSel.Count
					msgtxt = msgtxt & myOlSel.Item(x).Email1Address & ";"
					If Trim(myOlSel.Item(x).Email2Address) <> "" Then
						msgtxt = msgtxt & myOlSel.Item(x).Email2Address & ";"
					End If
					If Trim(myOlSel.Item(x).Email3Address) <> "" Then
						msgtxt = msgtxt & myOlSel.Item(x).Email3Address & ";"
					End If
				Next x
				'put selected emails to BCC
				.BCC = msgtxt
				' display de message
				.Display
			End With
		End Select
	End If
	Set olkItm = Nothing
End Sub