Penn White
ecritt1 at alltel.net
Wed Mar 15 05:55:40 CST 2006
Just to be complete for the archives, I thought I'd post my solution to this problem. Thanks very much to all who offered advice and got me thinking and exploring several new ways of doing things, especially using Custom Collection Classes which I didn't actually need here but will definitely use in future develpment tasks. Some references I found useful were the following: 1. Using Custom Collection Classes in Access http://www.databaseadvisors.com/newsletters/newsletter200503/0503usingcustomcollections/using%20custom%20collections%20in%20microsoft%20access.htm 2. How to Programmatically Export Items to Microsoft Access http://support.microsoft.com/?kbid=253794 3. Ten Tips for Microsoft Outlook Developers http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnout2k2/html/odc_novoltips.asp *************** CODE *************** Function Fn_CreateRecipList(ctlList As Control) As String ' 1. Creates Recipient string for 'SendObject' email. ' 2. Verifies that there is a Contact in Outlook for each Recipient. ' 3. If Contact in Outlook, verifies Email Address is current. ' Note: I have my own Error Handling routine so just substitute it with your own. Dim varItem As Variant Dim strRecip1 As String Dim strFirst1 As String Dim strLast1 As String Dim strEmail1 As String Dim strRecip As String ' Set up Outlook objects. Dim ol As New Outlook.Application Dim olCi As Outlook.ContactItem Dim cf As Outlook.MAPIFolder Dim olns As Outlook.NameSpace Dim olItems As Outlook.Items On Error GoTo Err_Fn_CreateRecipList ' Revised Error Handler Set ol = CreateObject("Outlook.Application") Set olns = ol.GetNamespace("MAPI") Set cf = olns.GetDefaultFolder(olFolderContacts) Set olItems = cf.Items For Each varItem In ctlList.ItemsSelected strFirst1 = ctlList.Column(3, varItem) strLast1 = ctlList.Column(2, varItem) If strFirst1 = "" And strLast1 = "" Then strRecip1 = ctlList.Column(1, varItem) strLast1 = strRecip1 Else strRecip1 = strFirst1 & " " & strLast1 End If strEmail1 = Fn_CreateOLEmail(ctlList.Column(4, varItem)) Set olCi = cf.Items.Find("[FullName] = '" & strRecip1 & "'") If TypeName(olCi) = "Nothing" Then ' Add Contact Set olCi = ol.CreateItem(olContactItem) olCi.FirstName = strFirst1 olCi.LastName = strLast1 olCi.Email1Address = strEmail1 olCi.Save Else ' Verify Email Address If olCi.Email1Address <> strEmail1 Then olCi.Email1Address = strEmail1 olCi.Save End If End If If Fn_IsNothing(strRecip) Then strRecip = strRecip1 Else strRecip = strRecip & "; " & strRecip1 End If Next varItem Fn_CreateRecipList = strRecip Exit_Fn_CreateRecipList: Set olCi = Nothing Set olItems = Nothing Set cf = Nothing Set olns = Nothing Set ol = Nothing Exit Function Err_Fn_CreateRecipList: Select Case Err.Number Case 0 Resume Next Case Else If Fn_ShowGenericErrorMsg("M_MiscFunctions", "Fn_CreateRecipList", Err.Number, Err.Description) = True Then Stop Resume Else Resume Exit_Fn_CreateRecipList End If End Select End Function