A
AS
Hi All,
Does anybody have any knowledge about creating and populating distribution
lists for ms outlook, using the emails stored in Excel files ? Or generally,
how would you programmatically create distribution lists, with 100s of
entries ?
I have been trying my hand at it and have come across some problems. I have
got it down to this now :
Above, I pick a name-email address pair fro the excel file and in the for
loop, for each pair, create a contact item, save it, add it to Recipients,
resolve it and add it to the DL.
The above seems to work OK for about 145 records from the excel file and I
have about 600 to add. Anything above 145 causes it to hang.
Can anybody please hlp refine/improve the above ?
Thank you.
-AS.
Does anybody have any knowledge about creating and populating distribution
lists for ms outlook, using the emails stored in Excel files ? Or generally,
how would you programmatically create distribution lists, with 100s of
entries ?
I have been trying my hand at it and have come across some problems. I have
got it down to this now :
Code:
Sub test()
Dim oExc As Excel.Application
Set oExc = New Excel.Application
Dim oWBook As Excel.Workbook
'Replace with location of your excel file.
Set oWBook = oExc.Workbooks.Open("C:\Documents and
Settings\SAM\Desktop\email.xls")
Dim oA As Outlook.Application
Set oA = New Outlook.Application
Dim oNs As Outlook.NameSpace
Set oNs = oA.GetNamespace("MAPI")
oNs.Logon "Microsoft Outlook", , False, True
Dim oContactsFolder As Outlook.MAPIFolder
Set oContactsFolder = oNs.GetDefaultFolder(olFolderContacts)
Dim oContactItem As Outlook.ContactItem
Dim oMess As Outlook.MailItem
Set oMess = oA.CreateItem(olMailItem)
Dim oRecipients As Outlook.Recipients
Set oRecipients = oMess.Recipients
Dim oDistList As Outlook.DistListItem
Set oDistList = oA.CreateItem(olDistributionListItem)
oDistList.DLName = "email_test"
oDistList.Move oContactsFolder
Dim cnt As Integer
'Dim totalRows As Integer
cnt = 1
'get the total rows in the excel file ....there may be a lib function
that already does this.
While oExc.Cells(cnt, 1) <> ""
totalRows = totalRows + 1
cnt = cnt + 1
Wend
'collect all email addresses from excel file and put them in the
recipients collection
'Col 1 in excel file is full name and col 2 is email address
For cnt = 2 To totalRows
Set oContactItem = oA.CreateItem(olContactItem)
Set oRecipients = oMess.Recipients
oContactItem.FullName = oExc.Cells(cnt, 1)
oContactItem.Email1Address = oExc.Cells(cnt, 2)
oContactItem.Save
oRecipients.Add oExc.Cells(cnt, 2)
If oRecipients.ResolveAll Then
oDistList.AddMembers oRecipients
End If
Set oContactItem = Nothing
Set oRecipients = Nothing
Next cnt
'save DL.
oDistList.Save
'clean up
Set wBook = Nothing
Set oExc = Nothing
Set oDistList = Nothing
Set oContactsFolder = Nothing
Set oMess = Nothing
oNs.Logoff
Set oNs = Nothing
oA.Quit
Set oA = Nothing
End SubAbove, I pick a name-email address pair fro the excel file and in the for
loop, for each pair, create a contact item, save it, add it to Recipients,
resolve it and add it to the DL.
The above seems to work OK for about 145 records from the excel file and I
have about 600 to add. Anything above 145 causes it to hang.
Can anybody please hlp refine/improve the above ?
Thank you.
-AS.