I have a sheet in an Excel file with names and email addresses.
I what to go through the sheet and update the Outlook group contacts that corresponds to the headers.
Sub CreateOutlookContactGroups()
Dim olApp As Object
Dim olNS As Object
Dim olContacts As Object
Dim olDistList As Object
Dim olRecip As Object
Dim lastRow As Long
Dim i As Long
'Get Outlook application object
Set olApp = CreateObject("Outlook.Application")
Set olNS = olApp.GetNamespace("MAPI")
Set olContacts = olNS.GetDefaultFolder(10) '10 = olFolderContacts
'Get last row of email addresses
lastRow = Cells(Rows.Count, "X").End(xlUp).Row
'Loop through each column from E to L in row 4
For i = 5 To 12 'Columns E to L
If Range(Cells(4, i), Cells(4, i)).Value <> "" Then 'Check if there is a value in cell
'Create or Get existing distribution list
On Error Resume Next
Set olDistList = olContacts.Items("IPM.DistList." & Range(Cells(4, i), Cells(4, i)).Value)
If olDistList Is Nothing Then 'Create new distribution list
Set olDistList = olContacts.Items.Add("IPM.DistList")
olDistList.Save
olDistList.Subject = Range(Cells(4, i), Cells(4, i)).Value
End If
On Error GoTo 0
'Add each email address from column X to distribution list if there is an "X" in the corresponding cell
For j = 6 To lastRow 'Row 6 to last row with email addresses
If Range(Cells(j, i), Cells(j, i)).Value = "X" Then 'Check if there is an "X" in cell
Set olRecip = olDistList.AddMember(CStr(Range(Cells(j, "X"), Cells(j, "X")).Value))
olDistList.Save
End If
Next j
End If
Next i
'Release Outlook objects
Set olRecip = Nothing
Set olDistList = Nothing
Set olContacts = Nothing
Set olNS = Nothing
Set olApp = Nothing
MsgBox "Kontakt grupper uppdaterrade!"
End Sub
The code stops running at
Set olRecip = olDistList.AddMember(CStr(Range(Cells(j, "X"), Cells(j, "X")).Value))
and throws a incompatible types fault, but the value is a valid email address.
The DistListItem.AddMember method accepts an instance of the Recipient
class to be added to the list. You can use the NameSpace.CreateRecipient method which creates a Recipient
object. The name of the recipient can be a string representing the display name, the alias, or the full SMTP email address of the recipient. For example:
Sub AddNewMember()
'Adds a member to a new distribution list
Dim objItem As Outlook.DistListItem
Dim objMail As Outlook.MailItem
Dim objRcpnt As Outlook.Recipient
Set objMail = Application.CreateItem(olMailItem)
Set objItem = Application.CreateItem(olDistributionListItem)
'Create recipient for distlist
Set objRcpnt = Application.Session.CreateRecipient("Eugene Astafiev") // or your email address
objRcpnt.Resolve
objItem.AddMember objRcpnt
'Add note to list and display
objItem.DLName = "Northwest Sales Manager"
objItem.Body = "Regional Sales Manager - NorthWest"
objItem.Save
objItem.Display
End Sub