Cannot make distribution list without resolving to Contacts Folder

E

Ed Adamthwaite

Hi all,
Ive tried to generate a Distribution list in Outlook by automation from
Access using Redemption.
The list is generated and saved in the Outlook Contacts folder.
When I try to send an email using the list, I get the Outlook error message:
"The personal distribution list(s) this message is addressed to must
contain recipients. Add at least one recipient to each list."

In Outlook I can manually create a distribution list without members from
Contacts, but cannot using code. Even though the type "SMTP" is passed in
the AddMemberEx loop, it doesn't get into the DistList member's Internet
type property. When I manually try to update, the member is resolved to the
Contacts folder and the SMTP is set after clicking the Custom/Internet
button.

I'd appreciate some pointers as to where I'm going wrong.

The code:

Sub MakeAccessSIGDL()
On Error GoTo ErrorHandler
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sDLname As String
Dim sSQL As String
Dim olApp As Object
Dim ns As Object
Dim myDL As Object
Dim rDL As Object
Dim sEntryID As String

Set olApp = CreateObject("Outlook.Application")
Set ns = olApp.GetNamespace("MAPI")
Set myDL = olApp.CreateItem(olDistributionListItem)
sDLname = "Access SIG List"
Set rDL = CreateObject("Redemption.SafeDistList")
myDL.Save
sEntryID = myDL.EntryID
'Debug.Print sEntryID
rDL.Item = myDL
Call DeleteDistributionList(sDLname)

sSQL = "SELECT Name, Address " _
& "FROM tblEmailAddresses " _
& "WHERE (((IsCurrent) = True)) " _
& "ORDER BY IIf(Len(GetString(1,[Name],' '))>1," _
& "GetString(2,[Name],' '),GetString(1,[Name],' '));"
'Debug.Print sSQL
Set conn = CurrentProject.Connection
Set rs = New ADODB.Recordset
With rs
.Open sSQL, conn, adOpenStatic, adLockOptimistic, adCmdText
.MoveLast 'force error 3021 if no records
.MoveFirst
Do Until .EOF
'CStr circumvents error- why?????
rDL.AddMemberEx CStr(.Fields("Name")), CStr(.Fields("Address")),
"SMTP"

.MoveNext
Loop
End With
rDL.DLName = sDLname
rDL.Save
Set rDL = Nothing
Set myDL = Nothing

Set myDL = ns.GetItemFromID(sEntryID)
myDL.SaveAs FILE_PATH_NAME & ".msg"
myDL.display

Set myDL = Nothing
Set rDL = Nothing
rs.Close
GoTo ThatsIt
ErrorHandler:
Select Case Err.Number
Case -2147217908
Case -2147217865 'cannot find table
Case 3021 'no records

Case Else
MsgBox "Problem with MakeAccessSIGDL()" & vbCrLf _
& "Error: & " & Err.Number & ": " & Err.Description
End Select
ThatsIt:
Set rs = Nothing
conn.Close
Set conn = Nothing
Set olApp = Nothing
Set ns = Nothing
End Sub

Regards,
Ed.
Ed Adamthwaite.
 
D

Dave Kane [MVP - Outlook]

Ed,

I tried AddMemberEx and I can't get it to work either, so maybe there's a
special trick or maybe it's got a bug. I'll ask Dmitry. But in the meantime
here's a minor change to your code that does work, using rDL.AddMember
(which expects a Recipient object):

....
With rs
.Open sSQL, conn, adOpenStatic, adLockOptimistic, adCmdText
.MoveLast 'force error 3021 if no records
.MoveFirst
Do Until .EOF
'CStr circumvents error: because the method expects a String
variable but .Fields("Name") is a Field object. 'It has a default
property of Value which in this case is a String datatype, but the method
doesn't know that 'automatically
'use AddMember in place of AddMemberEx.
'call SafeDistList.Recipeints.AddEx to create the required
SafeRecipient object
rDL.AddMember rDL.Recipients.AddEx(CStr(.Fields("Name")),
CStr(.Fields("Address")), "SMTP")
.MoveNext
Loop
End With

'once all the members have been added, get clear the Recipients collection
Do While rDL.Recipients.Count > 0
rDL.Recipients.Remove 1
Loop
....

Dave Kane
Ed Adamthwaite said:
Hi all,
Ive tried to generate a Distribution list in Outlook by automation from
Access using Redemption.
The list is generated and saved in the Outlook Contacts folder.
When I try to send an email using the list, I get the Outlook error
message:
"The personal distribution list(s) this message is addressed to must
contain recipients. Add at least one recipient to each list."

In Outlook I can manually create a distribution list without members from
Contacts, but cannot using code. Even though the type "SMTP" is passed in
the AddMemberEx loop, it doesn't get into the DistList member's Internet
type property. When I manually try to update, the member is resolved to
the Contacts folder and the SMTP is set after clicking the Custom/Internet
button.

I'd appreciate some pointers as to where I'm going wrong.

The code:

Sub MakeAccessSIGDL()
On Error GoTo ErrorHandler
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sDLname As String
Dim sSQL As String
Dim olApp As Object
Dim ns As Object
Dim myDL As Object
Dim rDL As Object
Dim sEntryID As String

Set olApp = CreateObject("Outlook.Application")
Set ns = olApp.GetNamespace("MAPI")
Set myDL = olApp.CreateItem(olDistributionListItem)
sDLname = "Access SIG List"
Set rDL = CreateObject("Redemption.SafeDistList")
myDL.Save
sEntryID = myDL.EntryID
'Debug.Print sEntryID
rDL.Item = myDL
Call DeleteDistributionList(sDLname)

sSQL = "SELECT Name, Address " _
& "FROM tblEmailAddresses " _
& "WHERE (((IsCurrent) = True)) " _
& "ORDER BY IIf(Len(GetString(1,[Name],' '))>1," _
& "GetString(2,[Name],' '),GetString(1,[Name],' '));"
'Debug.Print sSQL
Set conn = CurrentProject.Connection
Set rs = New ADODB.Recordset
With rs
.Open sSQL, conn, adOpenStatic, adLockOptimistic, adCmdText
.MoveLast 'force error 3021 if no records
.MoveFirst
Do Until .EOF
'CStr circumvents error- why?????
rDL.AddMemberEx CStr(.Fields("Name")), CStr(.Fields("Address")),
"SMTP"

.MoveNext
Loop
End With
rDL.DLName = sDLname
rDL.Save
Set rDL = Nothing
Set myDL = Nothing

Set myDL = ns.GetItemFromID(sEntryID)
myDL.SaveAs FILE_PATH_NAME & ".msg"
myDL.display

Set myDL = Nothing
Set rDL = Nothing
rs.Close
GoTo ThatsIt
ErrorHandler:
Select Case Err.Number
Case -2147217908
Case -2147217865 'cannot find table
Case 3021 'no records

Case Else
MsgBox "Problem with MakeAccessSIGDL()" & vbCrLf _
& "Error: & " & Err.Number & ": " & Err.Description
End Select
ThatsIt:
Set rs = Nothing
conn.Close
Set conn = Nothing
Set olApp = Nothing
Set ns = Nothing
End Sub

Regards,
Ed.
Ed Adamthwaite.
 
D

Dmitry Streblechenko

Works just fine here... Can you try the following script in OutlookSpy
(select a DL, click the Item button on the OutlookSpy toolbar, go to the
Script tab, paste the script, click Run).
Do you have a sample project which exhibits the problem? Can you send it to
me? Please rename all the executable (exe, dll, bas, etc) files first as my
mail server reject all messages with executable attachments.

set sItem = CreateObject("Redemption.SafeDistList")
sItem.Item = DistListItem
sItem.AddMemberEx "dmitry", "(e-mail address removed)", "SMTP"
sItem.Save

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

Dave Kane said:
Ed,

I tried AddMemberEx and I can't get it to work either, so maybe there's a
special trick or maybe it's got a bug. I'll ask Dmitry. But in the
meantime here's a minor change to your code that does work, using
rDL.AddMember (which expects a Recipient object):

...
With rs
.Open sSQL, conn, adOpenStatic, adLockOptimistic, adCmdText
.MoveLast 'force error 3021 if no records
.MoveFirst
Do Until .EOF
'CStr circumvents error: because the method expects a String
variable but .Fields("Name") is a Field object. 'It has a default
property of Value which in this case is a String datatype, but the method
doesn't know that 'automatically
'use AddMember in place of AddMemberEx.
'call SafeDistList.Recipeints.AddEx to create the required
SafeRecipient object
rDL.AddMember rDL.Recipients.AddEx(CStr(.Fields("Name")),
CStr(.Fields("Address")), "SMTP")
.MoveNext
Loop
End With

'once all the members have been added, get clear the Recipients collection
Do While rDL.Recipients.Count > 0
rDL.Recipients.Remove 1
Loop
...

Dave Kane
Ed Adamthwaite said:
Hi all,
Ive tried to generate a Distribution list in Outlook by automation from
Access using Redemption.
The list is generated and saved in the Outlook Contacts folder.
When I try to send an email using the list, I get the Outlook error
message:
"The personal distribution list(s) this message is addressed to must
contain recipients. Add at least one recipient to each list."

In Outlook I can manually create a distribution list without members from
Contacts, but cannot using code. Even though the type "SMTP" is passed in
the AddMemberEx loop, it doesn't get into the DistList member's Internet
type property. When I manually try to update, the member is resolved to
the Contacts folder and the SMTP is set after clicking the
Custom/Internet button.

I'd appreciate some pointers as to where I'm going wrong.

The code:

Sub MakeAccessSIGDL()
On Error GoTo ErrorHandler
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sDLname As String
Dim sSQL As String
Dim olApp As Object
Dim ns As Object
Dim myDL As Object
Dim rDL As Object
Dim sEntryID As String

Set olApp = CreateObject("Outlook.Application")
Set ns = olApp.GetNamespace("MAPI")
Set myDL = olApp.CreateItem(olDistributionListItem)
sDLname = "Access SIG List"
Set rDL = CreateObject("Redemption.SafeDistList")
myDL.Save
sEntryID = myDL.EntryID
'Debug.Print sEntryID
rDL.Item = myDL
Call DeleteDistributionList(sDLname)

sSQL = "SELECT Name, Address " _
& "FROM tblEmailAddresses " _
& "WHERE (((IsCurrent) = True)) " _
& "ORDER BY IIf(Len(GetString(1,[Name],' '))>1," _
& "GetString(2,[Name],' '),GetString(1,[Name],' '));"
'Debug.Print sSQL
Set conn = CurrentProject.Connection
Set rs = New ADODB.Recordset
With rs
.Open sSQL, conn, adOpenStatic, adLockOptimistic, adCmdText
.MoveLast 'force error 3021 if no records
.MoveFirst
Do Until .EOF
'CStr circumvents error- why?????
rDL.AddMemberEx CStr(.Fields("Name")), CStr(.Fields("Address")),
"SMTP"

.MoveNext
Loop
End With
rDL.DLName = sDLname
rDL.Save
Set rDL = Nothing
Set myDL = Nothing

Set myDL = ns.GetItemFromID(sEntryID)
myDL.SaveAs FILE_PATH_NAME & ".msg"
myDL.display

Set myDL = Nothing
Set rDL = Nothing
rs.Close
GoTo ThatsIt
ErrorHandler:
Select Case Err.Number
Case -2147217908
Case -2147217865 'cannot find table
Case 3021 'no records

Case Else
MsgBox "Problem with MakeAccessSIGDL()" & vbCrLf _
& "Error: & " & Err.Number & ": " & Err.Description
End Select
ThatsIt:
Set rs = Nothing
conn.Close
Set conn = Nothing
Set olApp = Nothing
Set ns = Nothing
End Sub

Regards,
Ed.
Ed Adamthwaite.
 
D

Dave Kane [MVP - Outlook]

I ran the script on OL2K3 and it appeared to work but didn't really. The
"dmitry" entry was added to list of members with a one-off icon but
something about apparently indicates to Outlook that it is really a Contact.
When I click "Update Now" it throws up the invalid contact prompt:
"Could not find Contact 'dmitry'. It may have been deleted or moved from its
original location. Would you like to remove it from this list?"

Likewise if I add the DL as a message recipient and then try to expand it
that raises an error about invalid entry/object could not be found.


Dmitry Streblechenko said:
Works just fine here... Can you try the following script in OutlookSpy
(select a DL, click the Item button on the OutlookSpy toolbar, go to the
Script tab, paste the script, click Run).
Do you have a sample project which exhibits the problem? Can you send it
to me? Please rename all the executable (exe, dll, bas, etc) files first
as my mail server reject all messages with executable attachments.

set sItem = CreateObject("Redemption.SafeDistList")
sItem.Item = DistListItem
sItem.AddMemberEx "dmitry", "(e-mail address removed)", "SMTP"
sItem.Save

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

Dave Kane said:
Ed,

I tried AddMemberEx and I can't get it to work either, so maybe there's a
special trick or maybe it's got a bug. I'll ask Dmitry. But in the
meantime here's a minor change to your code that does work, using
rDL.AddMember (which expects a Recipient object):

...
With rs
.Open sSQL, conn, adOpenStatic, adLockOptimistic, adCmdText
.MoveLast 'force error 3021 if no records
.MoveFirst
Do Until .EOF
'CStr circumvents error: because the method expects a String
variable but .Fields("Name") is a Field object. 'It has a default
property of Value which in this case is a String datatype, but the method
doesn't know that 'automatically
'use AddMember in place of AddMemberEx.
'call SafeDistList.Recipeints.AddEx to create the required
SafeRecipient object
rDL.AddMember rDL.Recipients.AddEx(CStr(.Fields("Name")),
CStr(.Fields("Address")), "SMTP")
.MoveNext
Loop
End With

'once all the members have been added, get clear the Recipients
collection
Do While rDL.Recipients.Count > 0
rDL.Recipients.Remove 1
Loop
...

Dave Kane
Ed Adamthwaite said:
Hi all,
Ive tried to generate a Distribution list in Outlook by automation from
Access using Redemption.
The list is generated and saved in the Outlook Contacts folder.
When I try to send an email using the list, I get the Outlook error
message:
"The personal distribution list(s) this message is addressed to must
contain recipients. Add at least one recipient to each list."

In Outlook I can manually create a distribution list without members
from Contacts, but cannot using code. Even though the type "SMTP" is
passed in the AddMemberEx loop, it doesn't get into the DistList
member's Internet type property. When I manually try to update, the
member is resolved to the Contacts folder and the SMTP is set after
clicking the Custom/Internet button.

I'd appreciate some pointers as to where I'm going wrong.

The code:

Sub MakeAccessSIGDL()
On Error GoTo ErrorHandler
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sDLname As String
Dim sSQL As String
Dim olApp As Object
Dim ns As Object
Dim myDL As Object
Dim rDL As Object
Dim sEntryID As String

Set olApp = CreateObject("Outlook.Application")
Set ns = olApp.GetNamespace("MAPI")
Set myDL = olApp.CreateItem(olDistributionListItem)
sDLname = "Access SIG List"
Set rDL = CreateObject("Redemption.SafeDistList")
myDL.Save
sEntryID = myDL.EntryID
'Debug.Print sEntryID
rDL.Item = myDL
Call DeleteDistributionList(sDLname)

sSQL = "SELECT Name, Address " _
& "FROM tblEmailAddresses " _
& "WHERE (((IsCurrent) = True)) " _
& "ORDER BY IIf(Len(GetString(1,[Name],' '))>1," _
& "GetString(2,[Name],' '),GetString(1,[Name],' '));"
'Debug.Print sSQL
Set conn = CurrentProject.Connection
Set rs = New ADODB.Recordset
With rs
.Open sSQL, conn, adOpenStatic, adLockOptimistic, adCmdText
.MoveLast 'force error 3021 if no records
.MoveFirst
Do Until .EOF
'CStr circumvents error- why?????
rDL.AddMemberEx CStr(.Fields("Name")), CStr(.Fields("Address")),
"SMTP"

.MoveNext
Loop
End With
rDL.DLName = sDLname
rDL.Save
Set rDL = Nothing
Set myDL = Nothing

Set myDL = ns.GetItemFromID(sEntryID)
myDL.SaveAs FILE_PATH_NAME & ".msg"
myDL.display

Set myDL = Nothing
Set rDL = Nothing
rs.Close
GoTo ThatsIt
ErrorHandler:
Select Case Err.Number
Case -2147217908
Case -2147217865 'cannot find table
Case 3021 'no records

Case Else
MsgBox "Problem with MakeAccessSIGDL()" & vbCrLf _
& "Error: & " & Err.Number & ": " & Err.Description
End Select
ThatsIt:
Set rs = Nothing
conn.Close
Set conn = Nothing
Set olApp = Nothing
Set ns = Nothing
End Sub

Regards,
Ed.
Ed Adamthwaite.
 
E

Ed Adamthwaite

Hello Dave & Dmitry,
Thank you both for your help.
Dave, your suggested changes worked! Bingo!

A question:
Why ...
Do While rDL.Recipients.Count > 0
rDL.Recipients.Remove 1
Loop
?
I thought that "Set rDL = Nothing" would kill the instance without requiring
any cleanup.

Thanks again. :)


Ed Adamthwaite said:
Hi all,
Ive tried to generate a Distribution list in Outlook by automation from
Access using Redemption.
The list is generated and saved in the Outlook Contacts folder.
When I try to send an email using the list, I get the Outlook error
message:
"The personal distribution list(s) this message is addressed to must
contain recipients. Add at least one recipient to each list."

In Outlook I can manually create a distribution list without members from
Contacts, but cannot using code. Even though the type "SMTP" is passed in
the AddMemberEx loop, it doesn't get into the DistList member's Internet
type property. When I manually try to update, the member is resolved to
the Contacts folder and the SMTP is set after clicking the Custom/Internet
button.

I'd appreciate some pointers as to where I'm going wrong.

The code:

Sub MakeAccessSIGDL()
On Error GoTo ErrorHandler
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sDLname As String
Dim sSQL As String
Dim olApp As Object
Dim ns As Object
Dim myDL As Object
Dim rDL As Object
Dim sEntryID As String

Set olApp = CreateObject("Outlook.Application")
Set ns = olApp.GetNamespace("MAPI")
Set myDL = olApp.CreateItem(olDistributionListItem)
sDLname = "Access SIG List"
Set rDL = CreateObject("Redemption.SafeDistList")
myDL.Save
sEntryID = myDL.EntryID
'Debug.Print sEntryID
rDL.Item = myDL
Call DeleteDistributionList(sDLname)

sSQL = "SELECT Name, Address " _
& "FROM tblEmailAddresses " _
& "WHERE (((IsCurrent) = True)) " _
& "ORDER BY IIf(Len(GetString(1,[Name],' '))>1," _
& "GetString(2,[Name],' '),GetString(1,[Name],' '));"
'Debug.Print sSQL
Set conn = CurrentProject.Connection
Set rs = New ADODB.Recordset
With rs
.Open sSQL, conn, adOpenStatic, adLockOptimistic, adCmdText
.MoveLast 'force error 3021 if no records
.MoveFirst
Do Until .EOF
'CStr circumvents error- why?????
rDL.AddMemberEx CStr(.Fields("Name")), CStr(.Fields("Address")),
"SMTP"

.MoveNext
Loop
End With
rDL.DLName = sDLname
rDL.Save
Set rDL = Nothing
Set myDL = Nothing

Set myDL = ns.GetItemFromID(sEntryID)
myDL.SaveAs FILE_PATH_NAME & ".msg"
myDL.display

Set myDL = Nothing
Set rDL = Nothing
rs.Close
GoTo ThatsIt
ErrorHandler:
Select Case Err.Number
Case -2147217908
Case -2147217865 'cannot find table
Case 3021 'no records

Case Else
MsgBox "Problem with MakeAccessSIGDL()" & vbCrLf _
& "Error: & " & Err.Number & ": " & Err.Description
End Select
ThatsIt:
Set rs = Nothing
conn.Close
Set conn = Nothing
Set olApp = Nothing
Set ns = Nothing
End Sub

Regards,
Ed.
Ed Adamthwaite.
 
E

Ed Adamthwaite

Also,

if i run...
Do While rDL.Recipients.Count > 0
rDL.Recipients.Remove 1
Loop
rDL.DLName = sDLname
rDL.Save
Set rDL = Nothing
Set myDL = Nothing

you'll notice that the remove loop happens before the rDL.Save line. Surely
this would make the final list empty?
Running the routine with or without the loop doesn't seem to have an impact
on the result.
I am confused.
:)
Ed.
 
D

Dmitry Streblechenko

Recipients collection is exposed simply because the SafeDistList object is
derived from an object that represents a generic IMessage Extended MAPI
wrapper.
The recipients collection in DL is not used by Outlook, it is *not* the same
as the Members collection.
Dave's code is resets it back to an empty list so that it can be used later.

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

Dmitry Streblechenko

Interesting... I can't even find the "Update Now" button, but expanding the
DL works fine.

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

Dave Kane said:
I ran the script on OL2K3 and it appeared to work but didn't really. The
"dmitry" entry was added to list of members with a one-off icon but
something about apparently indicates to Outlook that it is really a
Contact. When I click "Update Now" it throws up the invalid contact prompt:
"Could not find Contact 'dmitry'. It may have been deleted or moved from
its original location. Would you like to remove it from this list?"

Likewise if I add the DL as a message recipient and then try to expand it
that raises an error about invalid entry/object could not be found.


Dmitry Streblechenko said:
Works just fine here... Can you try the following script in OutlookSpy
(select a DL, click the Item button on the OutlookSpy toolbar, go to the
Script tab, paste the script, click Run).
Do you have a sample project which exhibits the problem? Can you send it
to me? Please rename all the executable (exe, dll, bas, etc) files first
as my mail server reject all messages with executable attachments.

set sItem = CreateObject("Redemption.SafeDistList")
sItem.Item = DistListItem
sItem.AddMemberEx "dmitry", "(e-mail address removed)", "SMTP"
sItem.Save

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

Dave Kane said:
Ed,

I tried AddMemberEx and I can't get it to work either, so maybe there's
a special trick or maybe it's got a bug. I'll ask Dmitry. But in the
meantime here's a minor change to your code that does work, using
rDL.AddMember (which expects a Recipient object):

...
With rs
.Open sSQL, conn, adOpenStatic, adLockOptimistic, adCmdText
.MoveLast 'force error 3021 if no records
.MoveFirst
Do Until .EOF
'CStr circumvents error: because the method expects a String
variable but .Fields("Name") is a Field object. 'It has a
default property of Value which in this case is a String datatype, but
the method doesn't know that 'automatically
'use AddMember in place of AddMemberEx.
'call SafeDistList.Recipeints.AddEx to create the required
SafeRecipient object
rDL.AddMember rDL.Recipients.AddEx(CStr(.Fields("Name")),
CStr(.Fields("Address")), "SMTP")
.MoveNext
Loop
End With

'once all the members have been added, get clear the Recipients
collection
Do While rDL.Recipients.Count > 0
rDL.Recipients.Remove 1
Loop
...

Dave Kane
Hi all,
Ive tried to generate a Distribution list in Outlook by automation from
Access using Redemption.
The list is generated and saved in the Outlook Contacts folder.
When I try to send an email using the list, I get the Outlook error
message:
"The personal distribution list(s) this message is addressed to must
contain recipients. Add at least one recipient to each list."

In Outlook I can manually create a distribution list without members
from Contacts, but cannot using code. Even though the type "SMTP" is
passed in the AddMemberEx loop, it doesn't get into the DistList
member's Internet type property. When I manually try to update, the
member is resolved to the Contacts folder and the SMTP is set after
clicking the Custom/Internet button.

I'd appreciate some pointers as to where I'm going wrong.

The code:

Sub MakeAccessSIGDL()
On Error GoTo ErrorHandler
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sDLname As String
Dim sSQL As String
Dim olApp As Object
Dim ns As Object
Dim myDL As Object
Dim rDL As Object
Dim sEntryID As String

Set olApp = CreateObject("Outlook.Application")
Set ns = olApp.GetNamespace("MAPI")
Set myDL = olApp.CreateItem(olDistributionListItem)
sDLname = "Access SIG List"
Set rDL = CreateObject("Redemption.SafeDistList")
myDL.Save
sEntryID = myDL.EntryID
'Debug.Print sEntryID
rDL.Item = myDL
Call DeleteDistributionList(sDLname)

sSQL = "SELECT Name, Address " _
& "FROM tblEmailAddresses " _
& "WHERE (((IsCurrent) = True)) " _
& "ORDER BY IIf(Len(GetString(1,[Name],' '))>1," _
& "GetString(2,[Name],' '),GetString(1,[Name],' '));"
'Debug.Print sSQL
Set conn = CurrentProject.Connection
Set rs = New ADODB.Recordset
With rs
.Open sSQL, conn, adOpenStatic, adLockOptimistic, adCmdText
.MoveLast 'force error 3021 if no records
.MoveFirst
Do Until .EOF
'CStr circumvents error- why?????
rDL.AddMemberEx CStr(.Fields("Name")), CStr(.Fields("Address")),
"SMTP"

.MoveNext
Loop
End With
rDL.DLName = sDLname
rDL.Save
Set rDL = Nothing
Set myDL = Nothing

Set myDL = ns.GetItemFromID(sEntryID)
myDL.SaveAs FILE_PATH_NAME & ".msg"
myDL.display

Set myDL = Nothing
Set rDL = Nothing
rs.Close
GoTo ThatsIt
ErrorHandler:
Select Case Err.Number
Case -2147217908
Case -2147217865 'cannot find table
Case 3021 'no records

Case Else
MsgBox "Problem with MakeAccessSIGDL()" & vbCrLf _
& "Error: & " & Err.Number & ": " & Err.Description
End Select
ThatsIt:
Set rs = Nothing
conn.Close
Set conn = Nothing
Set olApp = Nothing
Set ns = Nothing
End Sub

Regards,
Ed.
Ed Adamthwaite.
 
E

Ed Adamthwaite

Thanks Dmitry,
Wow! I doff my lid to you. This Redemption project must have taken an
enormous amount of work.

I am trying to visualise what is happening.
Consider the code:
....
rDL.AddMember rDL.Recipients.AddEx(.Fields("Name").Value,
..Fields("Address").Value, "SMTP")
....
So the "rDL" collection has a member "rDL.Recipients" which is also a
collection and you are copying a member from the rDL.Recipients to the rDL
collection?

also...
rDL.DLName = sDLname
rDL.Save
Set rDL = Nothing
Set myDL = Nothing


Being clear, does your reply mean that "Set rDL = Nothing" doesn't remove it
from memory?
If so, when is it disposed?

And from earlier post, Redemption doesn't allow for ".Value" to be the
default property for a Field object?
This is not a criticism, I assume that allowing for the default property in
all sorts of objects would blow out the size of your dll.

Thanks again,
Ed.
 
D

Dmitry Streblechenko

1. No, DistList has two collections : Members and Recipients. Outlook only
uses Members and wouldn't care less about the recipients since you never
send the DL itself as a message (unlike, say, MailItem). The reason the
Recipients collection is mentioned in this thread at all is only because
AddMembers method takes Recipients collection, which can either come from a
different message (the original thinking was probably "I'll take the whole
message and add all of its recipients as DL members") or from the DL itself
(just a matter of convinience so that you won't need to create a temporary
message, populate its recipients, then delete it).

2. The reference to rDL is removed, but I thought you meant that you needed
the Recipients colleciton to be emptied.

3. Redemption does not returns an object from Fields() (unlike CDO 1.21), it
returns the property value itself (Variant).

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

Ed Adamthwaite

Thanks Dmitry,
I am InformED.
Regards,
Ed

Dmitry Streblechenko said:
1. No, DistList has two collections : Members and Recipients. Outlook only
uses Members and wouldn't care less about the recipients since you never
send the DL itself as a message (unlike, say, MailItem). The reason the
Recipients collection is mentioned in this thread at all is only because
AddMembers method takes Recipients collection, which can either come from
a different message (the original thinking was probably "I'll take the
whole message and add all of its recipients as DL members") or from the DL
itself (just a matter of convinience so that you won't need to create a
temporary message, populate its recipients, then delete it).

2. The reference to rDL is removed, but I thought you meant that you
needed the Recipients colleciton to be emptied.

3. Redemption does not returns an object from Fields() (unlike CDO 1.21),
it returns the property value itself (Variant).

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

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top