adding redemption to my VB code leaves me with empty distribution list

  • Thread starter Thread starter Dan Hicks
  • Start date Start date
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
 
Send an e-mail to my private mail address and I'll send you an updated
version of the dll.

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool


Dan Hicks said:
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
Click to expand...
 
Thanks for the updated version Dmitry, but I'm still unable to create
the distribution list. I tried something simpler, like adding one
email address to a distribution list in my personal folder using
redemption code, but that hasn't worked either. Any ideas?

Dmitry Streblechenko \(MVP\) said:
Send an e-mail to my private mail address and I'll send you an updated
version of the dll.

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool


Dan Hicks said:
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
Click to expand...
Click to expand...
 
See my reply to your e-mail.

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool


Dan Hicks said:
Thanks for the updated version Dmitry, but I'm still unable to create
the distribution list. I tried something simpler, like adding one
email address to a distribution list in my personal folder using
redemption code, but that hasn't worked either. Any ideas?

"Dmitry Streblechenko \(MVP\)" <[email protected]> wrote in message
Send an e-mail to my private mail address and I'll send you an updated
version of the dll.

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool


Dan Hicks said:
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
Click to expand...
Click to expand...
Click to expand...
 
Back
Top