Import contacts to a shared mailbox

Not open for further replies.


New Member
Outlook version
Outlook 2013 32 bit
Email Account

I have the following macro that takes a list of email addresses in Excel and creates/updates an outlook distribution list under the 'My Contacts' section in Outlook - and this works perfectly.
However, how can i adapt this code so that it creates/updates the contacts in a shared mailbox called "Shared Test" instead of just on my mailbox. Any help would be greatly appreciated. Stu

Const DISTLISTNAME As String = "Test"
Const olDistributionListItem = 7
Const olFolderContacts = 10

Sub test() 'Worksheet_Change(ByVal Target As Range)

Dim outlook As Object ' Outlook.Application
Dim contacts As Object ' Outlook.Items
Dim myDistList As Object ' Outlook.DistListItem
Dim newDistList As Object ' Outlook.DistListItem
Dim objRcpnt As Object ' Outlook.Recipient
Dim arrData() As Variant
Dim rng As Excel.Range
Dim numRows As Long
Dim numCols As Long
Dim i As Long
Dim msg As String

msg = "Worksheet has been changed, would you like to update distribution list?"

If MsgBox(msg, vbYesNo) = vbNo Then
Exit Sub
End If

Set outlook = GetOutlookApp
Set contacts = GetItems(GetNS(outlook))

On Error Resume Next
Set myDistList = contacts.Item(DISTLISTNAME)
On Error GoTo 0

If Not myDistList Is Nothing Then
' delete it
End If

' recreate it
Set newDistList = outlook.CreateItem(olDistributionListItem)

With newDistList
End With

' loop through worksheet and add each member to dist list
numRows = Range("A1").CurrentRegion.Rows.Count - 1
numCols = Range("A1").CurrentRegion.Columns.Count

ReDim arrData(1 To numRows, 1 To numCols)

' take header out of range
Set rng = Range("A1").CurrentRegion.Offset(1, 0).Resize(numRows, numCols)
' put range into array
arrData = rng.Value

' assume 2 cols (name and emails only)
For i = 1 To numRows
'little variation on your theme ...
Set objRcpnt = outlook.Session.CreateRecipient(arrData(i, 1) & "<" & arrData(i, 2) & ">")
'end of variation
newDistList.AddMember objRcpnt
Next i


End Sub

Function GetOutlookApp() As Object
On Error Resume Next
Set GetOutlookApp = CreateObject("Outlook.Application")
End Function

'To My Contacts
Function GetItems(olNS As Object) As Object
Set GetItems = olNS.GetDefaultFolder(olFolderContacts).Items
End Function

Function GetNS(ByRef app As Object) As Object
Set GetNS = app.GetNamespace("MAPI")
End Function
Not open for further replies.
Similar threads
Thread starter Title Forum Replies Date
M PST import from Outlook 2007 to 2010 - Address Book contacts all in 1 group Using Outlook 4
C Import Outlook 2016 contacts into to: field Using Outlook 1
Diane Poremsky Batch Import Photos into Outlook Contacts Using Outlook 0
Diane Poremsky Macro to Bulk Import Contacts and vCards into Outlook Using Outlook 0
G Import pst but Calendar and Contacts don't show. Using Outlook 12
K Import Photos into Contacts Using Outlook 3
K How to import BCM data to Outlook Contacts? BCM (Business Contact Manager) 1
K Update contacts in BCM via new import BCM (Business Contact Manager) 1
C Way to import contacts from Excel into BCM Contacts? BCM (Business Contact Manager) 1
W Outlook 365 File access denied attempting to import .pst Using Outlook 6
S Import PST to Office 365 Using Outlook 2
C How to import Outlook calendar? Using Outlook 1
D ISOmacro to extract active mail senders name and email, CC, Subject line, and filename of attachments and import them into premade excel spread sheet Outlook VBA and Custom Forms 2
Z Import Tasks from Access Using VBA including User Defined Fields Outlook VBA and Custom Forms 0
J How to import many msg into different public folders in Outlook Outlook VBA and Custom Forms 7
K Disabling import/export button to restrict PST creation Using Outlook 3
I Outlook 365 - import/attach PST file that used POP3 Using accounts in Outlook 0
M Export-Import .pst file problems Using Outlook 2
N .pst archive from work will not open/import on Microsoft 365 Exchange Server Administration 0
Christopher M Import Exchange Server Administration 1
R PST-> (Import vs Drag-n-Drop methods Using accounts in Outlook 2
DoctorJellybean Import accounts\files Using Outlook 1
P Import Categories from Outlook 2003 Using Outlook 8
avant-guvnor Import csv problem Using Outlook 7
T Outlook 2016 CSV Translator Import Error Using Outlook 6
Rupert Dragwater How to import contact list Using Outlook 15
P Import an .ics file to a specific calendar Using Outlook 4
L Need to import multiple Outlook files to Office 365 Account Using Outlook 4
R ost file import Using Outlook 2
T Outlook Calendar 2016 import Excel Using Outlook 1
I Import Office theme .thmx Using Outlook 4
Diane Poremsky Can't import CSV or move Outlook items into EAS Accounts Using Outlook 0
Diane Poremsky How to Import Appointments into a Group Calendar Using Outlook 0
B Import Excel Text into Outlook Calender Using Outlook 4
M How to Import YES/NO Checkboxes? BCM (Business Contact Manager) 0
J Converted .ost to .pst: Want to Import and Reconnect with IMAP Email Account Using Outlook 2
GregS Import from .ost to IMAP .pst? Using Outlook 3
Q Outlook 2016\365 export specific rules to import in another system Exchange Server Administration 1
Diane Poremsky Import Images into the Active Directory Using Outlook 0
M convert/import a customized record into the default "Account" record BCM (Business Contact Manager) 0
Diane Poremsky Macro to Bulk Import vCards into Outlook Using Outlook 0
e_a_g_l_e_p_i question about saving my .pst so I can import it to my Outlook after I build a new system Using Outlook 10
V Import from Outlook 2013 ost file? Using Outlook 2
ogodt Change Default contact form and import from Excel 2010 Using Outlook 1
E Want to Import Outlook 2003 pst files to later version Using Outlook 6
A Does Outlook import Gmail Archive? Using Outlook 1
E PDF Import Using Outlook 1
B Problem with import Excel BCM (Business Contact Manager) 1
bhogesh How to import .htm saved mail to outlook Using Outlook 3
J Easy way to re-import Gmail folders/labels into Outlook? Using Outlook 9

Similar threads