D
Dan Hicks
Hi,
I've written a program that will convert views from SQL server into
outlook address books. It was working great, but I kept getting an
annoying security popup which I had to click through, so I tried
recoding my program with redemption (thank you to sue mosher and dude
who created redemption). Now I've eliminated the pop-up, but part of
my program which used to work now doesn't work. My program was able
to add a distribution list which included everybody in the address
book's email addresses. Now every time I run the program, all the
contacts are in the address list as well as the distribution list, but
the distribution list is always empty. No errors in the program, but
I can't figure out why it's not successfully adding these recipients
to the distribution list. Any ideas? Anyone? Here's the program I
wrote (not included are the OpenSQLServerDB subroutine and the
function call to this subroutine).
***********************************************
Sub ExportViewToOutlookAddressBook(viewName As String, addressBookName
As String, distributionName As String)
' Set up DAO Objects.
Set objMyConn = _
OpenSQLServerDB(...hidden stuff...)
Set rstBoard = CreateObject("ADODB.Recordset")
strSQL = "SELECT * " & _
"FROM " & viewName & ";"
rstBoard.Open strSQL, objMyConn
' Set up Outlook Objects.
Dim ol As New Outlook.Application
Dim olns As Outlook.Namespace
Dim cf As Outlook.MAPIFolder
'Dim c As Outlook.ContactItem :: this is replaced with redemption
code
Dim c As Object ' declare contact as object rather than
outlook.ContactItem
Dim rc As Object ' temporary item for use with redemption only
Dim Prop As Outlook.UserProperty
'Dim dl As Outlook.DistListItem :: this is replaced with redemption
code
Dim dl As Object ' declare dl as object
Dim rdl As Object ' temporary item for use with redemption only
Dim myTempItem As Object ' declare mailItem as object
Dim rMyTempItem As Object ' temporary item for use with redemption
only
Set olns = ol.GetNamespace("MAPI")
Set cf = olns.Folders("Public Folders").Folders("All Public
Folders").Folders(addressBookName)
' delete any items currently in folder
Set ContactItems = cf.Items
NumItems = ContactItems.Count
For I = NumItems To 1 Step -1
ContactItems(I).Delete
Next
' Set dl = cf.Items.Add(olDistributionListItem) :: this is replaced
with redemption code
Set rdl = cf.Items.Add(olDistributionListItem)
Set dl = CreateObject("Redemption.SafeDistList")
Set dl = rdl
dl.DLName = distributionName
' in place of olMailItem I could use the underlying constant value
of 0
' Set myTempItem = ol.CreateItem(olMailItem) :: this is replaced
with redemption code
Set rMyTempItem = ol.CreateItem(olMailItem)
Set myTempItem = CreateObject("Redemption.SafeMailItem")
myTempItem.Item = rMyTempItem
With rstBoard
.MoveFirst
' Loop through the Microsoft Access records.
Do While Not .EOF
' Create a new Contact item.
' Set c = cf.Items.Add(olContactItem) :: replaced with
redemption code
Set rc = cf.Items.Add(olContactItem)
Set c = CreateObject("Redemption.SafeContactItem")
c.Item = rc
' Create all built-in Outlook fields.
c.FirstName = ![first_name]
c.LastName = ![last_name]
c.JobTitle = ![position_name]
If (Len(![email_value]) > 0) Then
c.Email1Address = ![email_value]
Else
c.FirstName = ![first_name] & " (no email)"
End If
c.Email1DisplayName = ![display_name]
c.CompanyName = ![affiliation_name]
c.BusinessTelephoneNumber = ![phone_value]
c.BusinessFaxNumber = ![fax_value]
c.BusinessAddressStreet = ![line1]
c.BusinessAddressCity = ![city]
c.BusinessAddressState = ![state_id]
c.BusinessAddressPostalCode = ![postal_code]
If ![mobile_value] <> "" Then c.MobileTelephoneNumber =
![mobile_value]
' Save and close the contact.
c.Save
If (Len(![email_value]) > 0) Then
myTempItem.Recipients.Add c.Email1Address
End If
' Resolve email to address book name?
' myTempItem.Recipients.ResolveAll
' Add recipients to distribution list
dl.AddMembers myTempItem.Recipients
.MoveNext
Loop
End With
dl.Save
Set c = Nothing
Set rc = Nothing
Set myTempItem = Nothing
Set rMyTempItem = Nothing
Set dl = Nothing
Set rdl = Nothing
End Sub
I've written a program that will convert views from SQL server into
outlook address books. It was working great, but I kept getting an
annoying security popup which I had to click through, so I tried
recoding my program with redemption (thank you to sue mosher and dude
who created redemption). Now I've eliminated the pop-up, but part of
my program which used to work now doesn't work. My program was able
to add a distribution list which included everybody in the address
book's email addresses. Now every time I run the program, all the
contacts are in the address list as well as the distribution list, but
the distribution list is always empty. No errors in the program, but
I can't figure out why it's not successfully adding these recipients
to the distribution list. Any ideas? Anyone? Here's the program I
wrote (not included are the OpenSQLServerDB subroutine and the
function call to this subroutine).
***********************************************
Sub ExportViewToOutlookAddressBook(viewName As String, addressBookName
As String, distributionName As String)
' Set up DAO Objects.
Set objMyConn = _
OpenSQLServerDB(...hidden stuff...)
Set rstBoard = CreateObject("ADODB.Recordset")
strSQL = "SELECT * " & _
"FROM " & viewName & ";"
rstBoard.Open strSQL, objMyConn
' Set up Outlook Objects.
Dim ol As New Outlook.Application
Dim olns As Outlook.Namespace
Dim cf As Outlook.MAPIFolder
'Dim c As Outlook.ContactItem :: this is replaced with redemption
code
Dim c As Object ' declare contact as object rather than
outlook.ContactItem
Dim rc As Object ' temporary item for use with redemption only
Dim Prop As Outlook.UserProperty
'Dim dl As Outlook.DistListItem :: this is replaced with redemption
code
Dim dl As Object ' declare dl as object
Dim rdl As Object ' temporary item for use with redemption only
Dim myTempItem As Object ' declare mailItem as object
Dim rMyTempItem As Object ' temporary item for use with redemption
only
Set olns = ol.GetNamespace("MAPI")
Set cf = olns.Folders("Public Folders").Folders("All Public
Folders").Folders(addressBookName)
' delete any items currently in folder
Set ContactItems = cf.Items
NumItems = ContactItems.Count
For I = NumItems To 1 Step -1
ContactItems(I).Delete
Next
' Set dl = cf.Items.Add(olDistributionListItem) :: this is replaced
with redemption code
Set rdl = cf.Items.Add(olDistributionListItem)
Set dl = CreateObject("Redemption.SafeDistList")
Set dl = rdl
dl.DLName = distributionName
' in place of olMailItem I could use the underlying constant value
of 0
' Set myTempItem = ol.CreateItem(olMailItem) :: this is replaced
with redemption code
Set rMyTempItem = ol.CreateItem(olMailItem)
Set myTempItem = CreateObject("Redemption.SafeMailItem")
myTempItem.Item = rMyTempItem
With rstBoard
.MoveFirst
' Loop through the Microsoft Access records.
Do While Not .EOF
' Create a new Contact item.
' Set c = cf.Items.Add(olContactItem) :: replaced with
redemption code
Set rc = cf.Items.Add(olContactItem)
Set c = CreateObject("Redemption.SafeContactItem")
c.Item = rc
' Create all built-in Outlook fields.
c.FirstName = ![first_name]
c.LastName = ![last_name]
c.JobTitle = ![position_name]
If (Len(![email_value]) > 0) Then
c.Email1Address = ![email_value]
Else
c.FirstName = ![first_name] & " (no email)"
End If
c.Email1DisplayName = ![display_name]
c.CompanyName = ![affiliation_name]
c.BusinessTelephoneNumber = ![phone_value]
c.BusinessFaxNumber = ![fax_value]
c.BusinessAddressStreet = ![line1]
c.BusinessAddressCity = ![city]
c.BusinessAddressState = ![state_id]
c.BusinessAddressPostalCode = ![postal_code]
If ![mobile_value] <> "" Then c.MobileTelephoneNumber =
![mobile_value]
' Save and close the contact.
c.Save
If (Len(![email_value]) > 0) Then
myTempItem.Recipients.Add c.Email1Address
End If
' Resolve email to address book name?
' myTempItem.Recipients.ResolveAll
' Add recipients to distribution list
dl.AddMembers myTempItem.Recipients
.MoveNext
Loop
End With
dl.Save
Set c = Nothing
Set rc = Nothing
Set myTempItem = Nothing
Set rMyTempItem = Nothing
Set dl = Nothing
Set rdl = Nothing
End Sub