Distribution List Resets Problem

  • Thread starter Thread starter DaddyWalrusToon
  • Start date Start date
D

DaddyWalrusToon

I've been writing a script that is run by the rules wizard when a
incoming email has 'Subscribe' in the subject. The script gets th
sender name for the email and adds the sender to a distribution lis
called 'Lacota' in this case. This works fine ... the problem occur
when I close outlook and reopen it. When I do this the first email tha
comes through with 'Subscribe' in the subject wipes the distributio
list. HELP!!!

I am using Redemption too. Code below.

<-------------- Module Start -------------->
Sub AddContact(Item As Outlook.MailItem)

Dim sItem AS Redemption.SafeMailItem

Set sItem = CreateObject("Redemption.SafeMailItem")
sItem.Item = Item
CreateDistributionList sItem.SenderName

'Cleanup
Set Item = Nothing
Set sItem = Nothing

End Sub


Sub CreateDistributionList(EmailAddr As String)

Dim myOlApp As Outlook.Application
Dim myNameSpace As Outlook.NameSpace
Dim myFolder As Outlook.MAPIFolder
Dim myDistList As Outlook.DistListItem
Dim myContact As Outlook.ContactItem
Dim myMailItem As Outlook.MailItem
Dim sDistList As Redemption.SafeDistList
Dim sMailItem As Redemption.SafeMailItem

Set myOlApp = CreateObject("Outlook.Application")
Set myNameSpace = myOlApp.GetNamespace("MAPI")

'Create the new Contact
Set myContact = myOlApp.CreateItem(olContactItem)
myContact.FullName = EmailAddr
myContact.Email1Address = EmailAddr
myContact.Save

'Open Contacts folder
Set myFolder = myNameSpace.GetDefaultFolder(olFolderContacts)

'Open the Distribution List item
Set sDistList = CreateObject("Redemption.SafeDistList")
Set myDistList = myFolder.Items("Lacota")
sDistList.Item = myDistList
'sDistList.Display

'Add Email Address to Distribution List
Set sMailItem = CreateObject("Redemption.SafeMailItem")
Set myMailItem = myOlApp.CreateItem(olMailItem)
sMailItem.Item = myMailItem
sMailItem.Recipients.Add EmailAddr
sMailItem.Recipients.ResolveAll
sDistList.AddMembers sMailItem.Recipients
sDistList.Save

'Cleanup
Set myOlApp = Nothing
Set myNameSpace = Nothing
Set myFolder = Nothing
Set myDistList = Nothing
Set sDistList = Nothing
Set myMailItem = Nothing
Set sMailItem = Nothing

End Su
 
The latest version of Redemption (3.3.0.282) introduced this bug. Send me an
e-mail to my private address for an updated dll.

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