Welcome to Outlook Exchange


	Become a Columnist \| Microsoft Exchange Site \| Microsoft Support Site \| MSDN Exchange Site

Subscribe to OutlookExchange

What's New

Columnist

Development

More Resources

Software

Personalizing a Presentation for a Contact List

This section illustrates how you can personalize a PowerPoint presentation for your Outlook contacts, which can be an effective sales tool. The sample code below iterates through your Outlook Contacts folder and copies a PowerPoint presentation with a customized title slide for each contact. It then either e-mails the personalized presentation to the contact or saves the message in your Inbox so that you can add text and send it later. This code can be run from a Microsoft Excel, Word, or Microsoft Access module.

The procedure, PersonalizePresentation, takes two arguments: strFileName, which is the name of a presentation, and boolSendNow, a flag that indicates whether to send the presentations immediately or save them in the Inbox. The procedure opens the presentation and points a variable, txrRange, to the text of the title on the first slide. Next it iterates through the Contacts folder and adds each Contact's full name to txrRange and saves each modified presentation as contact name.ppt. If the contact has an e-mail address, it creates a MailItem and saves the personalized presentation as an attachment in your Inbox or sends it depending on which option is selected.

The code for this sample is in the modPersonalize module in XLSamp.xls. To run it, open XLSamp.xls and click Personalize Presentation on the Tools menu. When prompted for a presentation, browse to Sample.ppt.

Note To use this code in your own Microsoft Excel project, you must reference both the both Microsoft PowerPoint 8.0 Object Library and the Microsoft Outlook 8.0 Object.

Note that txrRange is declared as PowerPoint.TextRange because the application running this code may also have a TextRange object.

Public Sub PersonalizePresentation(strFileName As String, _
					boolSendNow As Boolean)

	Dim oPowerPoint As New PowerPoint.Application
	Dim oOutlook As New Outlook.Application
	Dim pptPresentation As Presentation
	Dim txrRange As PowerPoint.TextRange
	Dim intCounter As Integer
	Dim mitMailItem As MailItem
	Dim strNewFile As String
	Dim strEMailName As String
	Dim strMessage As String
	Dim strPath As String
	Dim lngSendNow As Long

	Const ERR_INVALID_PRESENTATION = 245755
	Const MESSAGE_CAPTION = "Personalizing a PowerPoint Presentation"
	On Error GoTo Err_PersonalizePresentation

	'Check to see if the file exists.
	If Len(Dir(strFileName, vbNormal)) > 0 Then
		oPowerPoint.Visible = msoTrue
		Set pptPresentation = oPowerPoint.Presentations.Open(strFileName)
		strPath = pptPresentation.Path

		Set txrRange = pptPresentation.Slides(1).Shapes(1) _
									.TextFrame.TextRange

		'Open the Contacts folder.
		With oOutlook.GetNamespace("MAPI"). _
			GetDefaultFolder(olFolderContacts).Items

			'Add Contact name to TextRange and save new Presentation.
			For intCounter = 1 To .Count
				txrRange.Text = .Item(intCounter).FullName _
								& "'s Presentation"

				strNewFile = strPath & _
				Application.PathSeparator & _
							.Item(intCounter).FullName & ".ppt"

				pptPresentation.SaveAs strNewFile

				'Send Presentation as Attachment if Contact has e-mail
				'address.
				strEMailName = .Item(intCounter).Email1Address
				If Len(strEMailName) > 0 Then
					Set mitMailItem = oOutlook.CreateItem(olMailItem)
					With mitMailItem
						.Attachments.Add strNewFile
						.Recipients.Add strEMailName
						.Subject = "Customized Presentation"
						If boolSendNow Then
							.Send
						Else
							.Save
						End If
					End With
				End If
			Next intCounter
		End With
	Else
		strMessage = "File not found!"
		MsgBox strMessage, vbCritical, MESSAGE_CAPTION
	End If

Exit_PersonalizePresentation:
	On Error Resume Next

	oPowerPoint.Quit
	Set oPowerPoint = Nothing
	Set pptPresentation = Nothing
	Set txrRange = Nothing
	Set oOutlook = Nothing

	Exit Sub
Err_PersonalizePresentation:
	If vbObjectError - Err = ERR_INVALID_PRESENTATION Then
		strMessage = "PowerPoint cannot open this file!"
	Else
		strMessage = "An unexpected error, #" & Err & " : " & _
									Error & " has occured."
	End If
	
	MsgBox strMessage, vbCritical, MESSAGE_CAPTION
	Resume Exit_PersonalizePresentation


End Sub

Disclaimer: Your use of the information contained in these pages is at your sole risk. All information on these pages is provided "as is", without any warranty, whether express or implied, of its accuracy, completeness, fitness for a particular purpose, title or non-infringement, and none of the third-party products or information mentioned in the work are authored, recommended, supported or guaranteed by Stephen Bryant or Pro Exchange. OutlookExchange.Com, Stephen Bryant and Pro Exchange shall not be liable for any damages you may sustain by using this information, whether direct, indirect, special, incidental or consequential, even if it has been advised of the possibility of such damages.