Hello,
I have a list of contacts stored in an Excel file. This Excel file is located in SharePoint. I regularly add or delete contacts (email, name, etc.) in this Excel file. That's why I want to automate the process of updating my Outlook contacts based on this Excel file.
I have implemented a solution that works when I want to store these contacts in the default Outlook folder named 'Contacts'. However, I don't want to store them in this folder. Instead, I have created a contact group named "groupe1" within the default folder, and it is in this group that I want to store the updated contacts. This way, when I want to send an email to these contacts, I can simply type the name of the group (groupe1) and retrieve all the contacts.
My real problem is as follows: When I'm in the "Contacts" folder, I need to access the "groupe1" group and modify the contact elements. Although my script below works without errors, the expected outcome is not achieved because the contacts in groupe1 are not being modified.
I would appreciate your assistance with this matter!
Sub UpdateOutlookContactsFromExcelSharePoint()
' SharePoint Configuration
Dim sharepointSiteURL As String
Dim sharepointFilePath As String
Dim excelFileName As String
Dim excelSheetName As String
sharepointSiteURL = "https://your-sharepoint-site-url.com"
sharepointFilePath = "/Shared Documents/Folder/ExcelFile.xlsx"
excelFileName = "ExcelFile.xlsx"
excelSheetName = "Sheet1"
' Outlook Configuration
Dim objOutlook As Object
Dim objNamespace As Object
Dim objContactsFolder As Object
Dim objContactGroup As Object
Dim objContact As Object
' Get a reference to Outlook
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
' Get a reference to the contacts folder
Set objContactsFolder = objNamespace.GetDefaultFolder(10)
' Contacts folder name
Dim contactsFolderName As String
contactsFolderName = "Contacts"
' Name of the contact group to access
Dim groupName As String
groupName = "groupe1"
' Loop through the contacts folders to find the "Contacts" folder
Dim contactsFolder As Object
For Each contactsFolder In objContactsFolder.Folders
If contactsFolder.Name = contactsFolderName Then
' Loop through the contact groups in the "Contacts" folder to find the specified group
For Each objContactGroup In contactsFolder.Folders
If objContactGroup.Name = groupName Then
' The specified contact group has been found
' Open the Excel file in SharePoint
Dim excelApp As Object
Dim excelWorkbook As Object
Dim excelWorksheet As Object
Dim rngData As Object
Dim rngRow As Object
' Create an instance of Excel application
Set excelApp = CreateObject("Excel.Application")
excelApp.Visible = False
excelApp.Workbooks.Open (sharepointSiteURL & sharepointFilePath)
Set excelWorkbook = excelApp.Workbooks(excelFileName)
Set excelWorksheet = excelWorkbook.Worksheets(excelSheetName)
' Get the data range from the Excel sheet
Set rngData = excelWorksheet.Range("A2:C" & excelWorksheet.Cells(excelWorksheet.Rows.Count, 1).End(-4162).Row)
' Loop through the data rows
For Each rngRow In rngData.Rows
Dim strEmailAddress As String
' Get the email address from the cell in column A
strEmailAddress = rngRow.Cells(1).Value
' Check if the email address is not empty
If Not IsEmpty(strEmailAddress) Then
' Find the corresponding contact in the contact group
Set objContact = objContactGroup.Items.Find("[Email1Address] = '" & strEmailAddress & "'")
' Check if the contact is found
If Not objContact Is Nothing Then
' Modify the contact properties with the data from the Excel row
objContact.FirstName = rngRow.Cells(2).Value
objContact.LastName = rngRow.Cells(3).Value
objContact.Email1Address = strEmailAddress
' Save the changes
objContact.Save
End If
End If
Next rngRow
' Close the Excel workbook and quit the Excel application
excelWorkbook.Close SaveChanges:=False
excelApp.Quit
' Clean up the Excel objects
Set rngData = Nothing
Set rngRow = Nothing
Set excelWorksheet = Nothing
Set excelWorkbook = Nothing
Set excelApp = Nothing
Exit For
End If
Next objContactGroup
Exit For
End If
Next contactsFolder
' Clean up Outlook objects
Set objContact = Nothing
Set objContactGroup = Nothing
Set objContactsFolder = Nothing
Set objNamespace = Nothing
Set objOutlook = Nothing
MsgBox "The contacts in the 'groupe1' contact group have been updated from the SharePoint Excel file.", vbInformation
End Sub
