[AccessD] Using Multidimensional Arrays

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





More information about the AccessD mailing list