ITPro44
asked on
Script Outlook to Update GAL- CONTINUED
My previous question has been deleted so I've created a new one in hopes that BlueDevilFan can further assist me with a script. I've also attached the deleted question as a PDF document so it can be reviewed.
To summarize, BlueDevilFan helped develop a script that will update a contact list in outlook. There were two solutions.
1. AD Option
- This solution pulled in contacts from AD
- As it was left, this option just pulled contacts into the users main contacts list, it did not create a separate contacts list.
- The improvement needed for this solution is pull from a specified distribution group and sync these contacts to a separate contact list. The name of the distribution group and contacts list should be able to be changed. If users are removed from the source distribution group, they should be removed from the contact list in outlook. If users info is updated or new users are added to the DG, the contacts should be updated and added.
2. GAL Option
- This pulled contacts from the GAL and attempted to pull them from the Offline Address Book and importing them to a new contact list within outlook called "Company Contacts".
- This solution bogged down outlook making it unusable during this import.
- For this to work, it would have to reliably pull from the OAB and not bog down outlook.
If we can get the AD option to work first that would be ideal. I think this will be the easiest option to get working as well.
Experts-Exchange-Question---Script-O.pdf
To summarize, BlueDevilFan helped develop a script that will update a contact list in outlook. There were two solutions.
1. AD Option
- This solution pulled in contacts from AD
- As it was left, this option just pulled contacts into the users main contacts list, it did not create a separate contacts list.
- The improvement needed for this solution is pull from a specified distribution group and sync these contacts to a separate contact list. The name of the distribution group and contacts list should be able to be changed. If users are removed from the source distribution group, they should be removed from the contact list in outlook. If users info is updated or new users are added to the DG, the contacts should be updated and added.
2. GAL Option
- This pulled contacts from the GAL and attempted to pull them from the Offline Address Book and importing them to a new contact list within outlook called "Company Contacts".
- This solution bogged down outlook making it unusable during this import.
- For this to work, it would have to reliably pull from the OAB and not bog down outlook.
If we can get the AD option to work first that would be ideal. I think this will be the easiest option to get working as well.
Experts-Exchange-Question---Script-O.pdf
ASKER
Here is the Code for the AD Solution.
'--> Create some constants
Const olFolderContacts = 10
'--> Create some variables
Dim excApp, excWkb, excWks, olkApp, olkSes, olkFld, olkCon, objADRDSE, adoCon, adoCmd, adoRS, adoField, intRow, strFields, strSource, arrRooms, strDNC, strManager, objManager
'--> Initialize variables
strFields = "manager,postalCode,st,l,roomNumber,streetAddress,Department,Company,physicalDeliveryOfficeName,mobile,TelephoneNumber,mail,title,givenName,SN,samAccountName"
'--> Turn error handling off
On Error Resume Next
'--> Create the Excel spreadsheet and write a header to it
Set excApp = CreateObject("Excel.Application")
Set excWkb = excApp.Workbooks.Add
Set excWks = excWkb.Worksheets(1)
With excWks
.cells(1,1) = "Account"
.cells(1,2) = "Last Name"
.cells(1,3) = "First Name"
.cells(1,4) = "Title"
.cells(1,5) = "Email"
.cells(1,6) = "Telephone"
.cells(1,7) = "Mobile"
.cells(1,8) = "Office"
.cells(1,9) = "Company"
.cells(1,10) = "Department"
.cells(1,11) = "Street"
.cells(1,12) = "Room"
.cells(1,13) = "City"
.cells(1,14) = "State"
.cells(1,15) = "Zip"
.cells(1,16) = "Manager"
End With
'--> Connect to and read AD
Set objADRDSE = GetObject("LDAP://RootDSE")
strDNC = objADRDSE.Get("defaultnamingcontext")
strSource = "'LDAP://" & strDNC & "'"
Set adoCon = CreateObject("ADODB.Connection")
adoCon.CursorLocation = 3
adoCon.Provider = "ADsDSOObject"
adoCon.Open "ADSI"
Set adoCmd = CreateObject("ADODB.Command")
adoCmd.ActiveConnection = adoCon
adoCmd.CommandText = "SELECT " & strFields & " FROM " & strSource & " Where objectClass='user' AND objectCategory='Person' ORDER BY samAccountName"
adoCmd.Properties("Size Limit") = 5000
adoCmd.Properties("Page Size") = 100
adoCmd.Properties("Timeout") = 30
adoCmd.Properties("Cache Results") = False
Set adoRS = adoCmd.Execute()
If Not adoRS.EOF Then
intRow = 2
Do While Not adoRS.EOF
With adoRS
For Each adoField In .Fields
Select Case LCase(adoField.name)
Case "samaccountname"
excWks.cells(intRow, 1) = adoField.value
Case "sn"
excWks.cells(intRow, 2) = adoField.value
Case "givenname"
excWks.cells(intRow, 3) = adoField.value
Case "title"
excWks.cells(intRow, 4) = adoField.value
Case "mail"
excWks.cells(intRow, 5) = adoField.value
Case "telephonenumber"
excWks.cells(intRow, 6) = adoField.value
Case "mobile"
excWks.cells(intRow, 7) = adoField.value
Case "physicaldeliveryofficename"
excWks.cells(intRow, 8) = adoField.value
Case "company"
excWks.cells(intRow, 9) = adoField.value
Case "department"
excWks.cells(intRow, 10) = adoField.value
Case "streetaddress"
excWks.cells(intRow, 11) = adoField.value
Case "roomnumber"
If Not IsNull(adoField.Value) Then
arrRooms = adoField.Value
excWks.cells(intRow, 12) = arrRooms(0)
End If
Case "l"
excWks.cells(intRow, 13) = adoField.value
Case "st"
excWks.cells(intRow, 14) = adoField.value
Case "postalcode"
excWks.cells(intRow, 15) = adoField.value
Case "manager"
If Not IsNull(adoField.value) Then
Set objManager = GetObject("LDAP://" & adoField.Value)
strManager = objManager.DisplayName
Else
strManager = ""
End If
excWks.cells(intRow,16) = strManager
Set objManager = Nothing
strManager = ""
End Select
Next
intRow = intRow + 1
.MoveNext
End With
Loop
End If
'--> Clean up AD objects
adoRS.Close
Set adoRS = Nothing
adoCon.Close
Set adoCon = Nothing
'--> Connect to Outlook
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon olkApp.DefaultProfileName
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts).Items
'--> Read the contacts downloaded from AD and add, update, or delete contacts from Outlook
For intRow = 2 To excWks.UsedRange.Rows.Count
If excWks.cells(intRow,2).value = "" or excWks.cells(intRow,3).value = "" Or excWks.cells(intRow,5).value = "" Then
Else
Set olkCon = olkFld.Find("[Nickname] = '" & Replace(excWks.cells(intRow,1).value, "'", "''") & "'")
If TypeName(olkCon) = "Nothing" Then
Set olkCon = olkFld.Add
olkCon.nickname = excWks.cells(intRow,1).value
End If
With olkCon
.LastName = excWks.cells(intRow,2).value
.Firstname = excWks.cells(intRow,3).value
.JobTitle = excWks.cells(intRow,4).value
.Email1Address = excWks.cells(intRow,5).value
.BusinessTelephoneNumber = excWks.cells(intRow,6).value
.MobileTelephoneNumber = excWks.cells(intRow,7).value
.OfficeLocation = excWks.cells(intRow,8).value
.CompanyName = excWks.cells(intRow,9).value
.Department = excWks.cells(intRow,10).value
.BusinessAddressStreet = excWks.cells(intRow,11).value
.BusinessAddressCity = excWks.cells(intRow,13).value
.BusinessAddressState = excWks.cells(intRow,14).value
.BusinessAddressPostalCode = excWks.cells(intRow,15).value
.ManagerName = excWks.cells(intRow,16).value
.Categories = "AutoUpdate"
.Save
End With
Set olkCon = Nothing
End If
Next
'--> Disconnect from Outlook
olkSes.Logoff
Set olkFld = Nothing
Set olkSes = Nothing
Set olkApp = Nothing
'--> Save and close the spreadsheet, then close Excel
excWkb.Close False
Set excWks = Nothing
Set excWkb = Nothing
excApp.Quit
Set excApp = Nothing
'--> Notify the user that the script has finished then terminate processing
WScript.Quit
What do "distribution group" and "separate contacts list" mean in this context? Does the former refer to an actual distribution group in Active Directory? Does the latter refer to a separate contacts folder in Outlook?
ASKER
Yes, in the script above, it filters out the users it's going to sync based on certain criteria. Instead of that, I'd like to have all users and contacts within a distribution group in AD sync.
Separate contacts list does mean separate contacts folder in outlook. I've attached a picture to show. It contains a separate contacts folder / separate contacts list called "Company Contacts".
company-contacts.jpg
Separate contacts list does mean separate contacts folder in outlook. I've attached a picture to show. It contains a separate contacts folder / separate contacts list called "Company Contacts".
company-contacts.jpg
Please clarify what "distribution group" means in this context. Are we talking an actual distribution group (aka a distribution list), an OU that contains the entries you want to copy, or something else? I need to know because the code varies depending on what we're talking about. For example, if we're talking about an actual distribution group, then the code needs to read the group, retrieve each member of the group, check to see if the member is an account or a nested group and then act accordingly. If instead we're talking about an OU, then the code is very different. I don't want to spend time writing the wrong code and then have to do it over.
ASKER
Distrbution group means distribution group in active directory.
ASKER
FYI - the original question should be viewable now.
https://www.experts-exchange.com/questions/28355578/Script-Outlook-to-Update-GAL-Contacts.html
https://www.experts-exchange.com/questions/28355578/Script-Outlook-to-Update-GAL-Contacts.html
I'm nearly finished with the revised script. How should it handle groups in the distribution list, or will there be any?
ASKER
Great!! Good question. If there are groups within the distribution group it should add the group itself, not the members of the group individually.
Ok, please try this version. This version syncs the contents of the specified list to an Outlook folder. For each entry in the list the code checks to see if it is for a user or a group. If it's a user, them the code creates an Outlook contact for that user. If it is a group, then the code creates an Outlook distribution list and adds the group's members to it. It only handles top-level groups. It does not create a group for every sub-group in the group. It does add sub-groups as members, but it doesn't copy the group to Outlook. Pay attention to the comments at the top of the code (i.e. in the Constants section).
'--> Create some constants
'On the next line edit the LDAP path to your Active Directory
Const LDAP_STRING = "LDAP://company.com/,DC=company,DC=com"
'On the next line edit the path to the contacts folder in Outlook the list is to be synced to
Const CONTACT_FOLDER_PATH = "john.doe@company.com\Contacts\Company Contacts"
'On the next line edit the email address of the list to sync from
Const DISTRIBUTION_GROUP_ADDRESS = "somelist@company.com"
'--> Create some variables
Dim objUsr, objGrp, olkApp, olkSes, olkFld, olkCon, adoCon, adoRec, arrRooms, strRoom, strManager, objAct, objManager, strClass, strBuf, arrTmp, varTmp, arrItm, lngCnt
'--> Initialize some variables
Set objUsr = CreateObject("Scripting.Dictionary")
Set objGrp = CreateObject("Scripting.Dictionary")
'--> Turn error handling off
On Error Resume Next
'--> Connect to and read AD
Set adoCon = CreateObject("ADODB.Connection")
With adoCon
.CursorLocation = 3
.Provider = "ADsDSOObject"
.Open "ADSI"
End With
Set adoRec = adoCon.Execute("SELECT adsPath,member FROM '" & LDAP_STRING & "' WHERE objectClass='group' AND mail='" & DISTRIBUTION_GROUP_ADDRESS & "'")
If Not IsEmpty(adoRec) Then
'--> Read AD
While Not adoRec.EOF
arrMembers = adoRec.Fields("Member")
For Each varMember In arrMembers
Set objAct = GetObject("LDAP://" & varMember)
strClass = Join(objAct.objectClass, ",")
If InStr(1, strClass, "user") > 0 Then
If Not IsNull(objAct.roomNumber) Then
arrRooms = objAct.roomNumber
strRoom = arrRooms(0)
Else
strRoom = ""
End If
If Not IsNull(objAct.manager) Then
Set objManager = GetObject("LDAP://" & objAct.manager)
strManager = objManager.DisplayName
Else
strManager = ""
End If
Set objManager = Nothing
strBuf = objAct.samAccountName & "|"
strBuf = strBuf & objAct.sn & "|"
strBuf = strBuf & objAct.givenName & "|"
strBuf = strBuf & objAct.title & "|"
strBuf = strBuf & objAct.mail & "|"
strBuf = strBuf & objAct.telephoneNumber & "|"
strBuf = strBuf & objAct.mobile & "|"
strBuf = strBuf & objAct.physicalDeliveryOfficeName & "|"
strBuf = strBuf & objAct.company & "|"
strBuf = strBuf & objAct.department & "|"
strBuf = strBuf & objAct.streetAddress & "|"
strBuf = strBuf & strRoom & "|"
strBuf = strBuf & objAct.l & "|"
strBuf = strBuf & objAct.st & "|"
strBuf = strBuf & objAct.postalCode & "|"
strBuf = strBuf & strManager & "|"
objUsr.Add objAct.samAccountName, strBuf
Else
If InStr(1, strClass, "group") > 0 Then
objGrp.add objAct.samAccountName, objAct.ADsPath
End If
End If
Next
adoRec.MoveNext
Wend
'--> Connect to Outlook
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon olkApp.DefaultProfileName
Set olkFld = OpenOutlookFolder(CONTACT_FOLDER_PATH)
'--> Delete the items from the Outlook folder
For lngCnt = olkFld.Items.Count To 1 Step -1
olkFld.Items.Remove lngCnt
Next
'--> Read the contacts downloaded from AD and add them to Outlook
arrTmp = objUsr.Items
For Each varTmp In arrTmp
arrItm = Split(varTmp, "|")
If (arrItm(1) = "") Or (arrItm(2) = "") Or (arrItm(4) = "") Then
Else
Set olkCon = olkFld.Items.Add
olkCon.nickname = arrItm(0)
With olkCon
.LastName = arrItm(1)
.Firstname = arrItm(2)
.JobTitle = arrItm(3)
.Email1Address = arrItm(4)
.BusinessTelephoneNumber = arrItm(5)
.MobileTelephoneNumber = arrItm(6)
.OfficeLocation = arrItm(7)
.CompanyName = arrItm(8)
.Department = arrItm(9)
.BusinessAddressStreet = arrItm(10)
.BusinessAddressCity = arrItm(12)
.BusinessAddressState = arrItm(13)
.BusinessAddressPostalCode = arrItm(14)
.ManagerName = arrItm(15)
.Categories = "AutoUpdate"
.Save
End With
Set olkCon = Nothing
End If
Next
'--> Read the groups downloaded from AD and add them to Outlook
arrTmp = objGrp.Items
For Each varTmp In arrTmp
CopyGroup varTmp
Next
'--> Disconnect from Outlook
olkSes.Logoff
Set olkFld = Nothing
Set olkSes = Nothing
Set olkApp = Nothing
End If
'--> Clean up AD objects
adoRec.Close
Set adoRec = Nothing
adoCon.Close
Set adoCon = Nothing
'--> Clean up other objects
Set objUsr = Nothing
Set objGrp = Nothing
Set objAct = Nothing
'--> Notify the user that the script has finished then terminate processing
WScript.Quit
Function OpenOutlookFolder(strFolderPath)
Dim arrFolders, varFolder, bolBeyondRoot
On Error Resume Next
If strFolderPath = "" Then
Set OpenOutlookFolder = Nothing
Else
Do While Left(strFolderPath, 1) = "\"
strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
Loop
arrFolders = Split(strFolderPath, "\")
For Each varFolder In arrFolders
Select Case bolBeyondRoot
Case False
Set OpenOutlookFolder = olkSes.Folders(varFolder)
bolBeyondRoot = True
Case True
Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
End Select
If Err.Number <> 0 Then
Set OpenOutlookFolder = Nothing
Exit For
End If
Next
End If
On Error GoTo 0
End Function
Sub CopyGroup(varPath)
Const olDistributionListItem = 7
Dim objGrp, olkGrp, olkRec, varMem, objAct
Set objGrp = GetObject(varPath)
Set olkGrp = olkFld.Items.Add(olDistributionListItem)
olkGrp.Subject = objGrp.displayName
'Set olkGrp = olkApp.CreateItem(olDistributionListItem)
For Each varMem In objGrp.member
Set objAct = GetObject("LDAP://" & varMem)
If objAct.mail <> "" Then
Set olkRec = olkSes.CreateRecipient(objAct.mail)
olkRec.Resolve
If olkRec.Resolved Then
olkGrp.AddMember olkRec
End If
End If
Next
olkGrp.Save
Set objGrp = Nothing
Set olkGrp = Nothing
Set olkRec = Nothing
Set objAct = Nothing
End Sub
ASKER
thanks BlueDevil! I gave it a go and can't seem to get it to run. In the original script the LDAP path was set to "LDAP://RootDSE" so it didn't need to be customized to our domain. Can that be used here? Also, the previous script did also not need to call out the contact folder path for a specific user. Can it just default to the logged on user?
This is what I changed in the script:
This is what I changed in the script:
'On the next line edit the LDAP path to your Active Directory
Const LDAP_STRING = "LDAP://localdomainname.local/,DC=localdomainname,DC=local"
'On the next line edit the path to the contacts folder in Outlook the list is to be synced to
Const CONTACT_FOLDER_PATH = "username@publicdomain.com\Contacts\Company Contacts"
'On the next line edit the email address of the list to sync from
Const DISTRIBUTION_GROUP_ADDRESS = "All@publicdomain.com"
I made those changes. Please try this version.
'--> Create some constants
'On the next line edit the email address of the list to sync from
Const DISTRIBUTION_GROUP_ADDRESS = "somelist@company.com"
Const SCRIPT_NAME = "List Sychronization (v1.0)"
Const olFolderContacts = 10
'--> Create some variables
Dim objUsr, objGrp, objAct, objManager, objADRDSE
Dim olkApp, olkSes, olkFld, olkCon
Dim adoCon, adoRec
Dim arrRooms, strRoom, strManager, strClass, strBuf, arrTmp, varTmp, arrItm, lngCnt, strSource, strDNC
'--> Initialize some variables
Set objUsr = CreateObject("Scripting.Dictionary")
Set objGrp = CreateObject("Scripting.Dictionary")
'--> Turn error handling off
On Error Resume Next
'--> get the AD root
Set objADRDSE = GetObject("LDAP://RootDSE")
strDNC = objADRDSE.Get("defaultnamingcontext")
strSource = "'LDAP://" & strDNC & "'"
'--> Connect to and read AD
Set adoCon = CreateObject("ADODB.Connection")
With adoCon
.CursorLocation = 3
.Provider = "ADsDSOObject"
.Open "ADSI"
End With
Set adoRec = adoCon.Execute("SELECT adsPath,member FROM '" & strSource & "' WHERE objectClass='group' AND mail='" & DISTRIBUTION_GROUP_ADDRESS & "'")
If Not IsEmpty(adoRec) Then
'--> Read AD
While Not adoRec.EOF
arrMembers = adoRec.Fields("Member")
For Each varMember In arrMembers
Set objAct = GetObject("LDAP://" & varMember)
strClass = Join(objAct.objectClass, ",")
If InStr(1, strClass, "user") > 0 Then
If Not IsNull(objAct.roomNumber) Then
arrRooms = objAct.roomNumber
strRoom = arrRooms(0)
Else
strRoom = ""
End If
If Not IsNull(objAct.manager) Then
Set objManager = GetObject("LDAP://" & objAct.manager)
strManager = objManager.DisplayName
Else
strManager = ""
End If
Set objManager = Nothing
strBuf = objAct.samAccountName & "|"
strBuf = strBuf & objAct.sn & "|"
strBuf = strBuf & objAct.givenName & "|"
strBuf = strBuf & objAct.title & "|"
strBuf = strBuf & objAct.mail & "|"
strBuf = strBuf & objAct.telephoneNumber & "|"
strBuf = strBuf & objAct.mobile & "|"
strBuf = strBuf & objAct.physicalDeliveryOfficeName & "|"
strBuf = strBuf & objAct.company & "|"
strBuf = strBuf & objAct.department & "|"
strBuf = strBuf & objAct.streetAddress & "|"
strBuf = strBuf & strRoom & "|"
strBuf = strBuf & objAct.l & "|"
strBuf = strBuf & objAct.st & "|"
strBuf = strBuf & objAct.postalCode & "|"
strBuf = strBuf & strManager & "|"
objUsr.Add objAct.samAccountName, strBuf
Else
If InStr(1, strClass, "group") > 0 Then
objGrp.add objAct.samAccountName, objAct.ADsPath
End If
End If
Next
adoRec.MoveNext
Wend
'--> Connect to Outlook
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon olkApp.DefaultProfileName
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts).Folders("Company Contacts")
'--> Delete the items from the Outlook folder
For lngCnt = olkFld.Items.Count To 1 Step -1
olkFld.Items.Remove lngCnt
Next
'--> Read the contacts downloaded from AD and add them to Outlook
arrTmp = objUsr.Items
For Each varTmp In arrTmp
arrItm = Split(varTmp, "|")
If (arrItm(1) = "") Or (arrItm(2) = "") Or (arrItm(4) = "") Then
Else
Set olkCon = olkFld.Items.Add
olkCon.nickname = arrItm(0)
With olkCon
.LastName = arrItm(1)
.Firstname = arrItm(2)
.JobTitle = arrItm(3)
.Email1Address = arrItm(4)
.BusinessTelephoneNumber = arrItm(5)
.MobileTelephoneNumber = arrItm(6)
.OfficeLocation = arrItm(7)
.CompanyName = arrItm(8)
.Department = arrItm(9)
.BusinessAddressStreet = arrItm(10)
.BusinessAddressCity = arrItm(12)
.BusinessAddressState = arrItm(13)
.BusinessAddressPostalCode = arrItm(14)
.ManagerName = arrItm(15)
.Categories = "AutoUpdate"
.Save
End With
Set olkCon = Nothing
End If
Next
'--> Read the groups downloaded from AD and add them to Outlook
arrTmp = objGrp.Items
For Each varTmp In arrTmp
CopyGroup varTmp
Next
'--> Disconnect from Outlook
olkSes.Logoff
Set olkFld = Nothing
Set olkSes = Nothing
Set olkApp = Nothing
End If
'--> Clean up AD objects
adoRec.Close
Set adoRec = Nothing
adoCon.Close
Set adoCon = Nothing
'--> Clean up other objects
Set objUsr = Nothing
Set objGrp = Nothing
Set objAct = Nothing
Set objADRDSE = Nothing
'--> Notify the user that the script has finished then terminate processing
MsgBox "Synchronization complete.", vbInformation+vbOKOnly, SCRIPT_NAME
WScript.Quit
Sub CopyGroup(varPath)
Const olDistributionListItem = 7
Dim objGrp, olkGrp, olkRec, varMem, objAct
Set objGrp = GetObject(varPath)
Set olkGrp = olkFld.Items.Add(olDistributionListItem)
olkGrp.Subject = objGrp.displayName
'Set olkGrp = olkApp.CreateItem(olDistributionListItem)
For Each varMem In objGrp.member
Set objAct = GetObject("LDAP://" & varMem)
If objAct.mail <> "" Then
Set olkRec = olkSes.CreateRecipient(objAct.mail)
olkRec.Resolve
If olkRec.Resolved Then
olkGrp.AddMember olkRec
End If
End If
Next
olkGrp.Save
Set objGrp = Nothing
Set olkGrp = Nothing
Set olkRec = Nothing
Set objAct = Nothing
End Sub
ASKER
ok, so it runs and says "Synchronization Complete" but no contacts are synced. I also do not see where i can rename the contacts folder where these contacts will be placed. It appears that you removed the path for to the contacts folder along with the ability to specify the name of the contacts folder. Please advise.
Edit line 84. Change "Company Contacts" to the name of the folder you want to sync to. That folder must be under the default Contacts folder.
ASKER
I manually created a contacts folder called "Company Contacts" but it still doesn't work for me. I don't know why. That said, if the contacts folder doesn't exist, can have the script create it?
Did you create the "Company Contacts" folder under your Contacts folder? If not, then that's the problem.
ASKER
Yes I did.
Yes, I can add code to create the "Company Contacts" folder if it doesn't exist. However, since the folder does exist and it is under your Contacts folder, the code should be working now. It works perfectly for me. Try commenting-out or removing line 18. Run it again and let me know if you get any errors. If you do, I need the complete wording of the error.
Please try this version.
'--> Create some constants
'On the next line edit the email address of the list to sync from
Const DISTRIBUTION_GROUP_ADDRESS = "somelist@company.com"
Const SCRIPT_NAME = "List Sychronization (v1.0)"
Const olFolderContacts = 10
'--> Create some variables
Dim objUsr, objGrp, objAct, objManager, objADRDSE
Dim olkApp, olkSes, olkFld, olkCon
Dim adoCon, adoRec
Dim arrRooms, strRoom, strManager, strClass, strBuf, arrTmp, varTmp, arrItm, lngCnt, strSource, strDNC
'--> Initialize some variables
Set objUsr = CreateObject("Scripting.Dictionary")
Set objGrp = CreateObject("Scripting.Dictionary")
'--> Turn error handling off
On Error Resume Next
'--> get the AD root
Set objADRDSE = GetObject("LDAP://RootDSE")
strDNC = objADRDSE.Get("defaultnamingcontext")
strSource = "LDAP://" & strDNC
'--> Connect to and read AD
Set adoCon = CreateObject("ADODB.Connection")
With adoCon
.CursorLocation = 3
.Provider = "ADsDSOObject"
.Open "ADSI"
End With
Set adoRec = adoCon.Execute("SELECT adsPath,member FROM '" & strSource & "' WHERE objectClass='group' AND mail='" & DISTRIBUTION_GROUP_ADDRESS & "'")
If Not IsEmpty(adoRec) Then
'--> Read AD
While Not adoRec.EOF
arrMembers = adoRec.Fields("Member")
For Each varMember In arrMembers
Set objAct = GetObject("LDAP://" & varMember)
strClass = Join(objAct.objectClass, ",")
If InStr(1, strClass, "user") > 0 Then
If Not IsNull(objAct.roomNumber) Then
arrRooms = objAct.roomNumber
strRoom = arrRooms(0)
Else
strRoom = ""
End If
If Not IsNull(objAct.manager) Then
Set objManager = GetObject("LDAP://" & objAct.manager)
strManager = objManager.DisplayName
Else
strManager = ""
End If
Set objManager = Nothing
strBuf = objAct.samAccountName & "|"
strBuf = strBuf & objAct.sn & "|"
strBuf = strBuf & objAct.givenName & "|"
strBuf = strBuf & objAct.title & "|"
strBuf = strBuf & objAct.mail & "|"
strBuf = strBuf & objAct.telephoneNumber & "|"
strBuf = strBuf & objAct.mobile & "|"
strBuf = strBuf & objAct.physicalDeliveryOfficeName & "|"
strBuf = strBuf & objAct.company & "|"
strBuf = strBuf & objAct.department & "|"
strBuf = strBuf & objAct.streetAddress & "|"
strBuf = strBuf & strRoom & "|"
strBuf = strBuf & objAct.l & "|"
strBuf = strBuf & objAct.st & "|"
strBuf = strBuf & objAct.postalCode & "|"
strBuf = strBuf & strManager & "|"
objUsr.Add objAct.samAccountName, strBuf
Else
If InStr(1, strClass, "group") > 0 Then
objGrp.add objAct.samAccountName, objAct.ADsPath
End If
End If
Next
adoRec.MoveNext
Wend
'--> Connect to Outlook
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon olkApp.DefaultProfileName
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts).Folders("Company Contacts")
'--> Delete the items from the Outlook folder
For lngCnt = olkFld.Items.Count To 1 Step -1
olkFld.Items.Remove lngCnt
Next
'--> Read the contacts downloaded from AD and add them to Outlook
arrTmp = objUsr.Items
For Each varTmp In arrTmp
arrItm = Split(varTmp, "|")
If (arrItm(1) = "") Or (arrItm(2) = "") Or (arrItm(4) = "") Then
Else
Set olkCon = olkFld.Items.Add
olkCon.nickname = arrItm(0)
With olkCon
.LastName = arrItm(1)
.Firstname = arrItm(2)
.JobTitle = arrItm(3)
.Email1Address = arrItm(4)
.BusinessTelephoneNumber = arrItm(5)
.MobileTelephoneNumber = arrItm(6)
.OfficeLocation = arrItm(7)
.CompanyName = arrItm(8)
.Department = arrItm(9)
.BusinessAddressStreet = arrItm(10)
.BusinessAddressCity = arrItm(12)
.BusinessAddressState = arrItm(13)
.BusinessAddressPostalCode = arrItm(14)
.ManagerName = arrItm(15)
.Categories = "AutoUpdate"
.Save
End With
Set olkCon = Nothing
End If
Next
'--> Read the groups downloaded from AD and add them to Outlook
arrTmp = objGrp.Items
For Each varTmp In arrTmp
CopyGroup varTmp
Next
'--> Disconnect from Outlook
olkSes.Logoff
Set olkFld = Nothing
Set olkSes = Nothing
Set olkApp = Nothing
End If
'--> Clean up AD objects
adoRec.Close
Set adoRec = Nothing
adoCon.Close
Set adoCon = Nothing
'--> Clean up other objects
Set objUsr = Nothing
Set objGrp = Nothing
Set objAct = Nothing
Set objADRDSE = Nothing
'--> Notify the user that the script has finished then terminate processing
MsgBox "Synchronization complete.", vbInformation+vbOKOnly, SCRIPT_NAME
WScript.Quit
Sub CopyGroup(varPath)
Const olDistributionListItem = 7
Dim objGrp, olkGrp, olkRec, varMem, objAct
Set objGrp = GetObject(varPath)
Set olkGrp = olkFld.Items.Add(olDistributionListItem)
olkGrp.Subject = objGrp.displayName
'Set olkGrp = olkApp.CreateItem(olDistributionListItem)
For Each varMem In objGrp.member
Set objAct = GetObject("LDAP://" & varMem)
If objAct.mail <> "" Then
Set olkRec = olkSes.CreateRecipient(objAct.mail)
olkRec.Resolve
If olkRec.Resolved Then
olkGrp.AddMember olkRec
End If
End If
Next
olkGrp.Save
Set objGrp = Nothing
Set olkGrp = Nothing
Set olkRec = Nothing
Set objAct = Nothing
End Sub
ASKER
Awesome!! It works great! Your awesome! I have two additional requests:
1. Can you have it create the Contacts Folder if it does not exist?
2. Can you make the name for Contacts Folder as a variable and make the variable defined at the top of the script (like the Distribution Group) so it's easily seen.
1. Can you have it create the Contacts Folder if it does not exist?
2. Can you make the name for Contacts Folder as a variable and make the variable defined at the top of the script (like the Distribution Group) so it's easily seen.
This version incorporates both of those changes.
'--> Create some constants
'On the next line edit the email address of the list to sync from
Const DISTRIBUTION_GROUP_ADDRESS = "somelist@company.com"
'On the next line edit the name of the Outlook folder to sync to
Const TARGET_FOLDER_NAME = "Company Contacts"
Const SCRIPT_NAME = "List Sychronization (v1.0)"
Const olFolderContacts = 10
'--> Create some variables
Dim objUsr, objGrp, objAct, objManager, objADRDSE
Dim olkApp, olkSes, olkFld, olkCon
Dim adoCon, adoRec
Dim arrRooms, strRoom, strManager, strClass, strBuf, arrTmp, varTmp, arrItm, lngCnt, strSource, strDNC
'--> Initialize some variables
Set objUsr = CreateObject("Scripting.Dictionary")
Set objGrp = CreateObject("Scripting.Dictionary")
'--> Turn error handling off
On Error Resume Next
'--> get the AD root
Set objADRDSE = GetObject("LDAP://RootDSE")
strDNC = objADRDSE.Get("defaultnamingcontext")
strSource = "'LDAP://" & strDNC & "'"
'--> Connect to and read AD
Set adoCon = CreateObject("ADODB.Connection")
With adoCon
.CursorLocation = 3
.Provider = "ADsDSOObject"
.Open "ADSI"
End With
Set adoRec = adoCon.Execute("SELECT adsPath,member FROM '" & strSource & "' WHERE objectClass='group' AND mail='" & DISTRIBUTION_GROUP_ADDRESS & "'")
If Not IsEmpty(adoRec) Then
'--> Read AD
While Not adoRec.EOF
arrMembers = adoRec.Fields("Member")
For Each varMember In arrMembers
Set objAct = GetObject("LDAP://" & varMember)
strClass = Join(objAct.objectClass, ",")
If InStr(1, strClass, "user") > 0 Then
If Not IsNull(objAct.roomNumber) Then
arrRooms = objAct.roomNumber
strRoom = arrRooms(0)
Else
strRoom = ""
End If
If Not IsNull(objAct.manager) Then
Set objManager = GetObject("LDAP://" & objAct.manager)
strManager = objManager.DisplayName
Else
strManager = ""
End If
Set objManager = Nothing
strBuf = objAct.samAccountName & "|"
strBuf = strBuf & objAct.sn & "|"
strBuf = strBuf & objAct.givenName & "|"
strBuf = strBuf & objAct.title & "|"
strBuf = strBuf & objAct.mail & "|"
strBuf = strBuf & objAct.telephoneNumber & "|"
strBuf = strBuf & objAct.mobile & "|"
strBuf = strBuf & objAct.physicalDeliveryOfficeName & "|"
strBuf = strBuf & objAct.company & "|"
strBuf = strBuf & objAct.department & "|"
strBuf = strBuf & objAct.streetAddress & "|"
strBuf = strBuf & strRoom & "|"
strBuf = strBuf & objAct.l & "|"
strBuf = strBuf & objAct.st & "|"
strBuf = strBuf & objAct.postalCode & "|"
strBuf = strBuf & strManager & "|"
objUsr.Add objAct.samAccountName, strBuf
Else
If InStr(1, strClass, "group") > 0 Then
objGrp.add objAct.samAccountName, objAct.ADsPath
End If
End If
Next
adoRec.MoveNext
Wend
'--> Connect to Outlook
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon olkApp.DefaultProfileName
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts).Folders(TARGET_FOLDER_NAME)
If IsEmpty(olkFld) Then
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts).Folders.Add(TARGET_FOLDER_NAME)
End If
'--> Delete the items from the Outlook folder
For lngCnt = olkFld.Items.Count To 1 Step -1
olkFld.Items.Remove lngCnt
Next
'--> Read the contacts downloaded from AD and add them to Outlook
arrTmp = objUsr.Items
For Each varTmp In arrTmp
arrItm = Split(varTmp, "|")
If (arrItm(1) = "") Or (arrItm(2) = "") Or (arrItm(4) = "") Then
Else
Set olkCon = olkFld.Items.Add
olkCon.nickname = arrItm(0)
With olkCon
.LastName = arrItm(1)
.Firstname = arrItm(2)
.JobTitle = arrItm(3)
.Email1Address = arrItm(4)
.BusinessTelephoneNumber = arrItm(5)
.MobileTelephoneNumber = arrItm(6)
.OfficeLocation = arrItm(7)
.CompanyName = arrItm(8)
.Department = arrItm(9)
.BusinessAddressStreet = arrItm(10)
.BusinessAddressCity = arrItm(12)
.BusinessAddressState = arrItm(13)
.BusinessAddressPostalCode = arrItm(14)
.ManagerName = arrItm(15)
.Categories = "AutoUpdate"
.Save
End With
Set olkCon = Nothing
End If
Next
'--> Read the groups downloaded from AD and add them to Outlook
arrTmp = objGrp.Items
For Each varTmp In arrTmp
CopyGroup varTmp
Next
'--> Disconnect from Outlook
olkSes.Logoff
Set olkFld = Nothing
Set olkSes = Nothing
Set olkApp = Nothing
End If
'--> Clean up AD objects
adoRec.Close
Set adoRec = Nothing
adoCon.Close
Set adoCon = Nothing
'--> Clean up other objects
Set objUsr = Nothing
Set objGrp = Nothing
Set objAct = Nothing
Set objADRDSE = Nothing
'--> Notify the user that the script has finished then terminate processing
MsgBox "Synchronization complete.", vbInformation+vbOKOnly, SCRIPT_NAME
WScript.Quit
Sub CopyGroup(varPath)
Const olDistributionListItem = 7
Dim objGrp, olkGrp, olkRec, varMem, objAct
Set objGrp = GetObject(varPath)
Set olkGrp = olkFld.Items.Add(olDistributionListItem)
olkGrp.Subject = objGrp.displayName
'Set olkGrp = olkApp.CreateItem(olDistributionListItem)
For Each varMem In objGrp.member
Set objAct = GetObject("LDAP://" & varMem)
If objAct.mail <> "" Then
Set olkRec = olkSes.CreateRecipient(objAct.mail)
olkRec.Resolve
If olkRec.Resolved Then
olkGrp.AddMember olkRec
End If
End If
Next
olkGrp.Save
Set objGrp = Nothing
Set olkGrp = Nothing
Set olkRec = Nothing
Set objAct = Nothing
End Sub
Sorry, I made the last change to an earlier version, one before I fixed yesterday's problem. This should do it.
'--> Create some constants
'On the next line edit the email address of the list to sync from
Const DISTRIBUTION_GROUP_ADDRESS = "somelist@company.com"
'On the next line edit the name of the Outlook folder to sync to
Const TARGET_FOLDER_NAME = "Company Contacts"
Const SCRIPT_NAME = "List Sychronization (v1.0)"
Const olFolderContacts = 10
'--> Create some variables
Dim objUsr, objGrp, objAct, objManager, objADRDSE
Dim olkApp, olkSes, olkFld, olkCon
Dim adoCon, adoRec
Dim arrRooms, strRoom, strManager, strClass, strBuf, arrTmp, varTmp, arrItm, lngCnt, strSource, strDNC
'--> Initialize some variables
Set objUsr = CreateObject("Scripting.Dictionary")
Set objGrp = CreateObject("Scripting.Dictionary")
'--> Turn error handling off
On Error Resume Next
'--> get the AD root
Set objADRDSE = GetObject("LDAP://RootDSE")
strDNC = objADRDSE.Get("defaultnamingcontext")
strSource = "LDAP://" & strDNC
'--> Connect to and read AD
Set adoCon = CreateObject("ADODB.Connection")
With adoCon
.CursorLocation = 3
.Provider = "ADsDSOObject"
.Open "ADSI"
End With
Set adoRec = adoCon.Execute("SELECT adsPath,member FROM '" & strSource & "' WHERE objectClass='group' AND mail='" & DISTRIBUTION_GROUP_ADDRESS & "'")
If Not IsEmpty(adoRec) Then
'--> Read AD
While Not adoRec.EOF
arrMembers = adoRec.Fields("Member")
For Each varMember In arrMembers
Set objAct = GetObject("LDAP://" & varMember)
strClass = Join(objAct.objectClass, ",")
If InStr(1, strClass, "user") > 0 Then
If Not IsNull(objAct.roomNumber) Then
arrRooms = objAct.roomNumber
strRoom = arrRooms(0)
Else
strRoom = ""
End If
If Not IsNull(objAct.manager) Then
Set objManager = GetObject("LDAP://" & objAct.manager)
strManager = objManager.DisplayName
Else
strManager = ""
End If
Set objManager = Nothing
strBuf = objAct.samAccountName & "|"
strBuf = strBuf & objAct.sn & "|"
strBuf = strBuf & objAct.givenName & "|"
strBuf = strBuf & objAct.title & "|"
strBuf = strBuf & objAct.mail & "|"
strBuf = strBuf & objAct.telephoneNumber & "|"
strBuf = strBuf & objAct.mobile & "|"
strBuf = strBuf & objAct.physicalDeliveryOfficeName & "|"
strBuf = strBuf & objAct.company & "|"
strBuf = strBuf & objAct.department & "|"
strBuf = strBuf & objAct.streetAddress & "|"
strBuf = strBuf & strRoom & "|"
strBuf = strBuf & objAct.l & "|"
strBuf = strBuf & objAct.st & "|"
strBuf = strBuf & objAct.postalCode & "|"
strBuf = strBuf & strManager & "|"
objUsr.Add objAct.samAccountName, strBuf
Else
If InStr(1, strClass, "group") > 0 Then
objGrp.add objAct.samAccountName, objAct.ADsPath
End If
End If
Next
adoRec.MoveNext
Wend
'--> Connect to Outlook
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon olkApp.DefaultProfileName
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts).Folders(TARGET_FOLDER_NAME)
If IsEmpty(olkFld) Then
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts).Folders.Add(TARGET_FOLDER_NAME)
End If
'--> Delete the items from the Outlook folder
For lngCnt = olkFld.Items.Count To 1 Step -1
olkFld.Items.Remove lngCnt
Next
'--> Read the contacts downloaded from AD and add them to Outlook
arrTmp = objUsr.Items
For Each varTmp In arrTmp
arrItm = Split(varTmp, "|")
If (arrItm(1) = "") Or (arrItm(2) = "") Or (arrItm(4) = "") Then
Else
Set olkCon = olkFld.Items.Add
olkCon.nickname = arrItm(0)
With olkCon
.LastName = arrItm(1)
.Firstname = arrItm(2)
.JobTitle = arrItm(3)
.Email1Address = arrItm(4)
.BusinessTelephoneNumber = arrItm(5)
.MobileTelephoneNumber = arrItm(6)
.OfficeLocation = arrItm(7)
.CompanyName = arrItm(8)
.Department = arrItm(9)
.BusinessAddressStreet = arrItm(10)
.BusinessAddressCity = arrItm(12)
.BusinessAddressState = arrItm(13)
.BusinessAddressPostalCode = arrItm(14)
.ManagerName = arrItm(15)
.Categories = "AutoUpdate"
.Save
End With
Set olkCon = Nothing
End If
Next
'--> Read the groups downloaded from AD and add them to Outlook
arrTmp = objGrp.Items
For Each varTmp In arrTmp
CopyGroup varTmp
Next
'--> Disconnect from Outlook
olkSes.Logoff
Set olkFld = Nothing
Set olkSes = Nothing
Set olkApp = Nothing
End If
'--> Clean up AD objects
adoRec.Close
Set adoRec = Nothing
adoCon.Close
Set adoCon = Nothing
'--> Clean up other objects
Set objUsr = Nothing
Set objGrp = Nothing
Set objAct = Nothing
Set objADRDSE = Nothing
'--> Notify the user that the script has finished then terminate processing
MsgBox "Synchronization complete.", vbInformation+vbOKOnly, SCRIPT_NAME
WScript.Quit
Sub CopyGroup(varPath)
Const olDistributionListItem = 7
Dim objGrp, olkGrp, olkRec, varMem, objAct
Set objGrp = GetObject(varPath)
Set olkGrp = olkFld.Items.Add(olDistributionListItem)
olkGrp.Subject = objGrp.displayName
'Set olkGrp = olkApp.CreateItem(olDistributionListItem)
For Each varMem In objGrp.member
Set objAct = GetObject("LDAP://" & varMem)
If objAct.mail <> "" Then
Set olkRec = olkSes.CreateRecipient(objAct.mail)
olkRec.Resolve
If olkRec.Resolved Then
olkGrp.AddMember olkRec
End If
End If
Next
olkGrp.Save
Set objGrp = Nothing
Set olkGrp = Nothing
Set olkRec = Nothing
Set objAct = Nothing
End Sub
ASKER
Right on! It works!
That said, I just noticed that it is not syncing "contacts". It's syncing all users fine, but we also need it to sync contacts within Active Directory as well. Can you add this ability?
That said, I just noticed that it is not syncing "contacts". It's syncing all users fine, but we also need it to sync contacts within Active Directory as well. Can you add this ability?
Try this.
'--> Create some constants
'On the next line edit the email address of the list to sync from
Const DISTRIBUTION_GROUP_ADDRESS = "somelist@company.com"
'On the next line edit the name of the Outlook folder to sync to
Const TARGET_FOLDER_NAME = "Company Contacts"
Const SCRIPT_NAME = "List Sychronization (v1.0)"
Const olFolderContacts = 10
'--> Create some variables
Dim objUsr, objGrp, objAct, objManager, objADRDSE
Dim olkApp, olkSes, olkFld, olkCon
Dim adoCon, adoRec
Dim arrRooms, strRoom, strManager, strClass, strBuf, arrTmp, varTmp, arrItm, lngCnt, strSource, strDNC
'--> Initialize some variables
Set objUsr = CreateObject("Scripting.Dictionary")
Set objGrp = CreateObject("Scripting.Dictionary")
'--> Turn error handling off
On Error Resume Next
'--> get the AD root
Set objADRDSE = GetObject("LDAP://RootDSE")
strDNC = objADRDSE.Get("defaultnamingcontext")
strSource = "LDAP://" & strDNC
'--> Connect to and read AD
Set adoCon = CreateObject("ADODB.Connection")
With adoCon
.CursorLocation = 3
.Provider = "ADsDSOObject"
.Open "ADSI"
End With
Set adoRec = adoCon.Execute("SELECT adsPath,member FROM '" & strSource & "' WHERE objectClass='group' AND mail='" & DISTRIBUTION_GROUP_ADDRESS & "'")
If Not IsEmpty(adoRec) Then
'--> Read AD
While Not adoRec.EOF
arrMembers = adoRec.Fields("Member")
For Each varMember In arrMembers
Set objAct = GetObject("LDAP://" & varMember)
strClass = Join(objAct.objectClass, ",")
If (InStr(1, strClass, "user") > 0) Or (InStr(1, strClass, "contact") > 0) Then
If Not IsNull(objAct.roomNumber) Then
arrRooms = objAct.roomNumber
strRoom = arrRooms(0)
Else
strRoom = ""
End If
If Not IsNull(objAct.manager) Then
Set objManager = GetObject("LDAP://" & objAct.manager)
strManager = objManager.DisplayName
Else
strManager = ""
End If
Set objManager = Nothing
strBuf = objAct.samAccountName & "|"
strBuf = strBuf & objAct.sn & "|"
strBuf = strBuf & objAct.givenName & "|"
strBuf = strBuf & objAct.title & "|"
strBuf = strBuf & objAct.mail & "|"
strBuf = strBuf & objAct.telephoneNumber & "|"
strBuf = strBuf & objAct.mobile & "|"
strBuf = strBuf & objAct.physicalDeliveryOfficeName & "|"
strBuf = strBuf & objAct.company & "|"
strBuf = strBuf & objAct.department & "|"
strBuf = strBuf & objAct.streetAddress & "|"
strBuf = strBuf & strRoom & "|"
strBuf = strBuf & objAct.l & "|"
strBuf = strBuf & objAct.st & "|"
strBuf = strBuf & objAct.postalCode & "|"
strBuf = strBuf & strManager & "|"
objUsr.Add objAct.samAccountName, strBuf
Else
If InStr(1, strClass, "group") > 0 Then
objGrp.add objAct.samAccountName, objAct.ADsPath
End If
End If
Next
adoRec.MoveNext
Wend
'--> Connect to Outlook
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon olkApp.DefaultProfileName
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts).Folders(TARGET_FOLDER_NAME)
If IsEmpty(olkFld) Then
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts).Folders.Add(TARGET_FOLDER_NAME)
End If
'--> Delete the items from the Outlook folder
For lngCnt = olkFld.Items.Count To 1 Step -1
olkFld.Items.Remove lngCnt
Next
'--> Read the contacts downloaded from AD and add them to Outlook
arrTmp = objUsr.Items
For Each varTmp In arrTmp
arrItm = Split(varTmp, "|")
If (arrItm(1) = "") Or (arrItm(2) = "") Or (arrItm(4) = "") Then
Else
Set olkCon = olkFld.Items.Add
olkCon.nickname = arrItm(0)
With olkCon
.LastName = arrItm(1)
.Firstname = arrItm(2)
.JobTitle = arrItm(3)
.Email1Address = arrItm(4)
.BusinessTelephoneNumber = arrItm(5)
.MobileTelephoneNumber = arrItm(6)
.OfficeLocation = arrItm(7)
.CompanyName = arrItm(8)
.Department = arrItm(9)
.BusinessAddressStreet = arrItm(10)
.BusinessAddressCity = arrItm(12)
.BusinessAddressState = arrItm(13)
.BusinessAddressPostalCode = arrItm(14)
.ManagerName = arrItm(15)
.Categories = "AutoUpdate"
.Save
End With
Set olkCon = Nothing
End If
Next
'--> Read the groups downloaded from AD and add them to Outlook
arrTmp = objGrp.Items
For Each varTmp In arrTmp
CopyGroup varTmp
Next
'--> Disconnect from Outlook
olkSes.Logoff
Set olkFld = Nothing
Set olkSes = Nothing
Set olkApp = Nothing
End If
'--> Clean up AD objects
adoRec.Close
Set adoRec = Nothing
adoCon.Close
Set adoCon = Nothing
'--> Clean up other objects
Set objUsr = Nothing
Set objGrp = Nothing
Set objAct = Nothing
Set objADRDSE = Nothing
'--> Notify the user that the script has finished then terminate processing
MsgBox "Synchronization complete.", vbInformation+vbOKOnly, SCRIPT_NAME
WScript.Quit
Sub CopyGroup(varPath)
Const olDistributionListItem = 7
Dim objGrp, olkGrp, olkRec, varMem, objAct
Set objGrp = GetObject(varPath)
Set olkGrp = olkFld.Items.Add(olDistributionListItem)
olkGrp.Subject = objGrp.displayName
'Set olkGrp = olkApp.CreateItem(olDistributionListItem)
For Each varMem In objGrp.member
Set objAct = GetObject("LDAP://" & varMem)
If objAct.mail <> "" Then
Set olkRec = olkSes.CreateRecipient(objAct.mail)
olkRec.Resolve
If olkRec.Resolved Then
olkGrp.AddMember olkRec
End If
End If
Next
olkGrp.Save
Set objGrp = Nothing
Set olkGrp = Nothing
Set olkRec = Nothing
Set objAct = Nothing
End Sub
ASKER
The script runs and does everything else just fine, but contacts are still not being synced.
Are you certain the group contains contacts? If it does, then does each contact entry have the first name, last name, and email address filled out? If any of those are missing, then the code skips over the item.
ASKER
Hey David, you were right! This contact did not have an email address associated with it. That said, is it possible to remove the check for the email address? I should also ask if this is advisable as I'm not exactly sure your intent for making it this way. Please advise.
ASKER
Hi David - on a different topic, I have created seperate question that requires similar scripting abilities within outlook. This script will actually complement what you have helped me create here. I would be happy if you could help on this question. thanks!
https://www.experts-exchange.com/questions/28942837/Script-a-way-to-Delete-Contacts-within-Oulook.html
https://www.experts-exchange.com/questions/28942837/Script-a-way-to-Delete-Contacts-within-Oulook.html
It is possible to remove that filter, but I don't recommend it. What's the point in having an entry in a email distribution list that doesn't have an email address?
ASKER
Because this is use to sync contacts in addition to users, some of the contacts only have a phone number. i.e. phone numbers for different office in this specific scenario.
Is there a specific reason you don't recommend it?
Is there a specific reason you don't recommend it?
No, there's no technical reason not to It just seems odd to have entries without email addresses. I've removed that restriction from this version.
'--> Create some constants
'On the next line edit the email address of the list to sync from
Const DISTRIBUTION_GROUP_ADDRESS = "somelist@company.com"
'On the next line edit the name of the Outlook folder to sync to
Const TARGET_FOLDER_NAME = "Company Contacts"
Const SCRIPT_NAME = "List Sychronization (v1.0)"
Const olFolderContacts = 10
'--> Create some variables
Dim objUsr, objGrp, objAct, objManager, objADRDSE
Dim olkApp, olkSes, olkFld, olkCon
Dim adoCon, adoRec
Dim arrRooms, strRoom, strManager, strClass, strBuf, arrTmp, varTmp, arrItm, lngCnt, strSource, strDNC
'--> Initialize some variables
Set objUsr = CreateObject("Scripting.Dictionary")
Set objGrp = CreateObject("Scripting.Dictionary")
'--> Turn error handling off
On Error Resume Next
'--> get the AD root
Set objADRDSE = GetObject("LDAP://RootDSE")
strDNC = objADRDSE.Get("defaultnamingcontext")
strSource = "LDAP://" & strDNC
'--> Connect to and read AD
Set adoCon = CreateObject("ADODB.Connection")
With adoCon
.CursorLocation = 3
.Provider = "ADsDSOObject"
.Open "ADSI"
End With
Set adoRec = adoCon.Execute("SELECT adsPath,member FROM '" & strSource & "' WHERE objectClass='group' AND mail='" & DISTRIBUTION_GROUP_ADDRESS & "'")
If Not IsEmpty(adoRec) Then
'--> Read AD
While Not adoRec.EOF
arrMembers = adoRec.Fields("Member")
For Each varMember In arrMembers
Set objAct = GetObject("LDAP://" & varMember)
strClass = Join(objAct.objectClass, ",")
If (InStr(1, strClass, "user") > 0) Or (InStr(1, strClass, "contact") > 0) Then
If Not IsNull(objAct.roomNumber) Then
arrRooms = objAct.roomNumber
strRoom = arrRooms(0)
Else
strRoom = ""
End If
If Not IsNull(objAct.manager) Then
Set objManager = GetObject("LDAP://" & objAct.manager)
strManager = objManager.DisplayName
Else
strManager = ""
End If
Set objManager = Nothing
strBuf = objAct.samAccountName & "|"
strBuf = strBuf & objAct.sn & "|"
strBuf = strBuf & objAct.givenName & "|"
strBuf = strBuf & objAct.title & "|"
strBuf = strBuf & objAct.mail & "|"
strBuf = strBuf & objAct.telephoneNumber & "|"
strBuf = strBuf & objAct.mobile & "|"
strBuf = strBuf & objAct.physicalDeliveryOfficeName & "|"
strBuf = strBuf & objAct.company & "|"
strBuf = strBuf & objAct.department & "|"
strBuf = strBuf & objAct.streetAddress & "|"
strBuf = strBuf & strRoom & "|"
strBuf = strBuf & objAct.l & "|"
strBuf = strBuf & objAct.st & "|"
strBuf = strBuf & objAct.postalCode & "|"
strBuf = strBuf & strManager & "|"
objUsr.Add objAct.samAccountName, strBuf
Else
If InStr(1, strClass, "group") > 0 Then
objGrp.add objAct.samAccountName, objAct.ADsPath
End If
End If
Next
adoRec.MoveNext
Wend
'--> Connect to Outlook
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon olkApp.DefaultProfileName
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts).Folders(TARGET_FOLDER_NAME)
If IsEmpty(olkFld) Then
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts).Folders.Add(TARGET_FOLDER_NAME)
End If
'--> Delete the items from the Outlook folder
For lngCnt = olkFld.Items.Count To 1 Step -1
olkFld.Items.Remove lngCnt
Next
'--> Read the contacts downloaded from AD and add them to Outlook
arrTmp = objUsr.Items
For Each varTmp In arrTmp
arrItm = Split(varTmp, "|")
If (arrItm(1) = "") Or (arrItm(2) = "") Then
Else
Set olkCon = olkFld.Items.Add
olkCon.nickname = arrItm(0)
With olkCon
.LastName = arrItm(1)
.Firstname = arrItm(2)
.JobTitle = arrItm(3)
.Email1Address = arrItm(4)
.BusinessTelephoneNumber = arrItm(5)
.MobileTelephoneNumber = arrItm(6)
.OfficeLocation = arrItm(7)
.CompanyName = arrItm(8)
.Department = arrItm(9)
.BusinessAddressStreet = arrItm(10)
.BusinessAddressCity = arrItm(12)
.BusinessAddressState = arrItm(13)
.BusinessAddressPostalCode = arrItm(14)
.ManagerName = arrItm(15)
.Categories = "AutoUpdate"
.Save
End With
Set olkCon = Nothing
End If
Next
'--> Read the groups downloaded from AD and add them to Outlook
arrTmp = objGrp.Items
For Each varTmp In arrTmp
CopyGroup varTmp
Next
'--> Disconnect from Outlook
olkSes.Logoff
Set olkFld = Nothing
Set olkSes = Nothing
Set olkApp = Nothing
End If
'--> Clean up AD objects
adoRec.Close
Set adoRec = Nothing
adoCon.Close
Set adoCon = Nothing
'--> Clean up other objects
Set objUsr = Nothing
Set objGrp = Nothing
Set objAct = Nothing
Set objADRDSE = Nothing
'--> Notify the user that the script has finished then terminate processing
MsgBox "Synchronization complete.", vbInformation+vbOKOnly, SCRIPT_NAME
WScript.Quit
Sub CopyGroup(varPath)
Const olDistributionListItem = 7
Dim objGrp, olkGrp, olkRec, varMem, objAct
Set objGrp = GetObject(varPath)
Set olkGrp = olkFld.Items.Add(olDistributionListItem)
olkGrp.Subject = objGrp.displayName
'Set olkGrp = olkApp.CreateItem(olDistributionListItem)
For Each varMem In objGrp.member
Set objAct = GetObject("LDAP://" & varMem)
If objAct.mail <> "" Then
Set olkRec = olkSes.CreateRecipient(objAct.mail)
olkRec.Resolve
If olkRec.Resolved Then
olkGrp.AddMember olkRec
End If
End If
Next
olkGrp.Save
Set objGrp = Nothing
Set olkGrp = Nothing
Set olkRec = Nothing
Set objAct = Nothing
End Sub
ASKER
Thanks David, that's great!
I just realized that there are some additional fields that we need to synchronize. Can you add the following fields?:
1. Fax Number
2. IP Phone
3. Home Phone
4. Web Page
I just realized that there are some additional fields that we need to synchronize. Can you add the following fields?:
1. Fax Number
2. IP Phone
3. Home Phone
4. Web Page
Ok, I've added those additional fields. Outlook contacts do not have a field specifically for the IP phone number, so I have the solution inserting that into the second business telephone number. If you want it in some other field, then let me know which one and I'll move it there.
'--> Create some constants
'On the next line edit the email address of the list to sync from
Const DISTRIBUTION_GROUP_ADDRESS = "somelist@company.com"
'On the next line edit the name of the Outlook folder to sync to
Const TARGET_FOLDER_NAME = "Company Contacts"
Const SCRIPT_NAME = "List Sychronization (v1.0)"
Const olFolderContacts = 10
'--> Create some variables
Dim objUsr, objGrp, objAct, objManager, objADRDSE
Dim olkApp, olkSes, olkFld, olkCon
Dim adoCon, adoRec
Dim arrRooms, strRoom, strManager, strClass, strBuf, arrTmp, varTmp, arrItm, lngCnt, strSource, strDNC
'--> Initialize some variables
Set objUsr = CreateObject("Scripting.Dictionary")
Set objGrp = CreateObject("Scripting.Dictionary")
'--> Turn error handling off
On Error Resume Next
'--> get the AD root
Set objADRDSE = GetObject("LDAP://RootDSE")
strDNC = objADRDSE.Get("defaultnamingcontext")
strSource = "LDAP://" & strDNC
'--> Connect to and read AD
Set adoCon = CreateObject("ADODB.Connection")
With adoCon
.CursorLocation = 3
.Provider = "ADsDSOObject"
.Open "ADSI"
End With
Set adoRec = adoCon.Execute("SELECT adsPath,member FROM '" & strSource & "' WHERE objectClass='group' AND mail='" & DISTRIBUTION_GROUP_ADDRESS & "'")
If Not IsEmpty(adoRec) Then
'--> Read AD
While Not adoRec.EOF
arrMembers = adoRec.Fields("Member")
For Each varMember In arrMembers
Set objAct = GetObject("LDAP://" & varMember)
strClass = Join(objAct.objectClass, ",")
If (InStr(1, strClass, "user") > 0) Or (InStr(1, strClass, "contact") > 0) Then
If Not IsNull(objAct.roomNumber) Then
arrRooms = objAct.roomNumber
strRoom = arrRooms(0)
Else
strRoom = ""
End If
If Not IsNull(objAct.manager) Then
Set objManager = GetObject("LDAP://" & objAct.manager)
strManager = objManager.DisplayName
Else
strManager = ""
End If
Set objManager = Nothing
strBuf = objAct.samAccountName & "|"
strBuf = strBuf & objAct.sn & "|"
strBuf = strBuf & objAct.givenName & "|"
strBuf = strBuf & objAct.title & "|"
strBuf = strBuf & objAct.mail & "|"
strBuf = strBuf & objAct.telephoneNumber & "|"
strBuf = strBuf & objAct.mobile & "|"
strBuf = strBuf & objAct.physicalDeliveryOfficeName & "|"
strBuf = strBuf & objAct.company & "|"
strBuf = strBuf & objAct.department & "|"
strBuf = strBuf & objAct.streetAddress & "|"
strBuf = strBuf & strRoom & "|"
strBuf = strBuf & objAct.l & "|"
strBuf = strBuf & objAct.st & "|"
strBuf = strBuf & objAct.postalCode & "|"
strBuf = strBuf & strManager & "|"
strBuf = strBuf & objAct.facsimileTelephoneNumber & "|"
strBuf = strBuf & objAct.homePhone & "|"
strBuf = strBuf & objAct.ipPhone & "|"
strBuf = strBuf & objAct.wWWHomePage & "|"
objUsr.Add objAct.samAccountName, strBuf
Else
If InStr(1, strClass, "group") > 0 Then
objGrp.add objAct.samAccountName, objAct.ADsPath
End If
End If
Next
adoRec.MoveNext
Wend
'--> Connect to Outlook
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon olkApp.DefaultProfileName
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts).Folders(TARGET_FOLDER_NAME)
If IsEmpty(olkFld) Then
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts).Folders.Add(TARGET_FOLDER_NAME)
End If
'--> Delete the items from the Outlook folder
For lngCnt = olkFld.Items.Count To 1 Step -1
olkFld.Items.Remove lngCnt
Next
'--> Read the contacts downloaded from AD and add them to Outlook
arrTmp = objUsr.Items
For Each varTmp In arrTmp
arrItm = Split(varTmp, "|")
If (arrItm(1) = "") Or (arrItm(2) = "") Then
Else
Set olkCon = olkFld.Items.Add
olkCon.nickname = arrItm(0)
With olkCon
.LastName = arrItm(1)
.Firstname = arrItm(2)
.JobTitle = arrItm(3)
.Email1Address = arrItm(4)
.BusinessTelephoneNumber = arrItm(5)
.MobileTelephoneNumber = arrItm(6)
.OfficeLocation = arrItm(7)
.CompanyName = arrItm(8)
.Department = arrItm(9)
.BusinessAddressStreet = arrItm(10)
.BusinessAddressCity = arrItm(12)
.BusinessAddressState = arrItm(13)
.BusinessAddressPostalCode = arrItm(14)
.ManagerName = arrItm(15)
.BusinesFaxNumber = arrItm(16)
.HomeTelephoneNumber = arrItm(17)
.Business2TelephoneNumber = arrItm(18)
.WebPage = arrItm(19)
.Categories = "AutoUpdate"
.Save
End With
Set olkCon = Nothing
End If
Next
'--> Read the groups downloaded from AD and add them to Outlook
arrTmp = objGrp.Items
For Each varTmp In arrTmp
CopyGroup varTmp
Next
'--> Disconnect from Outlook
olkSes.Logoff
Set olkFld = Nothing
Set olkSes = Nothing
Set olkApp = Nothing
End If
'--> Clean up AD objects
adoRec.Close
Set adoRec = Nothing
adoCon.Close
Set adoCon = Nothing
'--> Clean up other objects
Set objUsr = Nothing
Set objGrp = Nothing
Set objAct = Nothing
Set objADRDSE = Nothing
'--> Notify the user that the script has finished then terminate processing
MsgBox "Synchronization complete.", vbInformation+vbOKOnly, SCRIPT_NAME
WScript.Quit
Sub CopyGroup(varPath)
Const olDistributionListItem = 7
Dim objGrp, olkGrp, olkRec, varMem, objAct
Set objGrp = GetObject(varPath)
Set olkGrp = olkFld.Items.Add(olDistributionListItem)
olkGrp.Subject = objGrp.displayName
'Set olkGrp = olkApp.CreateItem(olDistributionListItem)
For Each varMem In objGrp.member
Set objAct = GetObject("LDAP://" & varMem)
If objAct.mail <> "" Then
Set olkRec = olkSes.CreateRecipient(objAct.mail)
olkRec.Resolve
If olkRec.Resolved Then
olkGrp.AddMember olkRec
End If
End If
Next
olkGrp.Save
Set objGrp = Nothing
Set olkGrp = Nothing
Set olkRec = Nothing
Set objAct = Nothing
End Sub
ASKER
thank you. So I'm running into several problems.
1. Only one contact will Sync. Multiple contacts within a set distribution group will not sync.
2. Fax numbers are not syncing.
3. I have removed the work phone number from all contacts with AD last week. This work number is still being synchronized. I have no idea where the script is pulling this info from. Any ideas what's going on here?
1. Only one contact will Sync. Multiple contacts within a set distribution group will not sync.
2. Fax numbers are not syncing.
3. I have removed the work phone number from all contacts with AD last week. This work number is still being synchronized. I have no idea where the script is pulling this info from. Any ideas what's going on here?
ASKER
problem 1 and 3 exists in the previous code as well.
ASKER
ok, scratch problem 3, that is not an issue.
Sorry, but I don't understand what #1 means.
This version fixes a typo which was causing #2.
This version fixes a typo which was causing #2.
'--> Create some constants
'On the next line edit the email address of the list to sync from
Const DISTRIBUTION_GROUP_ADDRESS = "somelist@company.com"
'On the next line edit the name of the Outlook folder to sync to
Const TARGET_FOLDER_NAME = "Company Contacts"
Const SCRIPT_NAME = "List Sychronization (v1.0)"
Const olFolderContacts = 10
'--> Create some variables
Dim objUsr, objGrp, objAct, objManager, objADRDSE
Dim olkApp, olkSes, olkFld, olkCon
Dim adoCon, adoRec
Dim arrRooms, strRoom, strManager, strClass, strBuf, arrTmp, varTmp, arrItm, lngCnt, strSource, strDNC
'--> Initialize some variables
Set objUsr = CreateObject("Scripting.Dictionary")
Set objGrp = CreateObject("Scripting.Dictionary")
'--> Turn error handling off
On Error Resume Next
'--> get the AD root
Set objADRDSE = GetObject("LDAP://RootDSE")
strDNC = objADRDSE.Get("defaultnamingcontext")
strSource = "LDAP://" & strDNC
'--> Connect to and read AD
Set adoCon = CreateObject("ADODB.Connection")
With adoCon
.CursorLocation = 3
.Provider = "ADsDSOObject"
.Open "ADSI"
End With
Set adoRec = adoCon.Execute("SELECT adsPath,member FROM '" & strSource & "' WHERE objectClass='group' AND mail='" & DISTRIBUTION_GROUP_ADDRESS & "'")
If Not IsEmpty(adoRec) Then
'--> Read AD
While Not adoRec.EOF
arrMembers = adoRec.Fields("Member")
For Each varMember In arrMembers
Set objAct = GetObject("LDAP://" & varMember)
strClass = Join(objAct.objectClass, ",")
If (InStr(1, strClass, "user") > 0) Or (InStr(1, strClass, "contact") > 0) Then
If Not IsNull(objAct.roomNumber) Then
arrRooms = objAct.roomNumber
strRoom = arrRooms(0)
Else
strRoom = ""
End If
If Not IsNull(objAct.manager) Then
Set objManager = GetObject("LDAP://" & objAct.manager)
strManager = objManager.DisplayName
Else
strManager = ""
End If
Set objManager = Nothing
strBuf = objAct.samAccountName & "|"
strBuf = strBuf & objAct.sn & "|"
strBuf = strBuf & objAct.givenName & "|"
strBuf = strBuf & objAct.title & "|"
strBuf = strBuf & objAct.mail & "|"
strBuf = strBuf & objAct.telephoneNumber & "|"
strBuf = strBuf & objAct.mobile & "|"
strBuf = strBuf & objAct.physicalDeliveryOfficeName & "|"
strBuf = strBuf & objAct.company & "|"
strBuf = strBuf & objAct.department & "|"
strBuf = strBuf & objAct.streetAddress & "|"
strBuf = strBuf & strRoom & "|"
strBuf = strBuf & objAct.l & "|"
strBuf = strBuf & objAct.st & "|"
strBuf = strBuf & objAct.postalCode & "|"
strBuf = strBuf & strManager & "|"
strBuf = strBuf & objAct.facsimileTelephoneNumber & "|"
strBuf = strBuf & objAct.homePhone & "|"
strBuf = strBuf & objAct.ipPhone & "|"
strBuf = strBuf & objAct.wWWHomePage & "|"
objUsr.Add objAct.samAccountName, strBuf
Else
If InStr(1, strClass, "group") > 0 Then
objGrp.add objAct.samAccountName, objAct.ADsPath
End If
End If
Next
adoRec.MoveNext
Wend
'--> Connect to Outlook
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon olkApp.DefaultProfileName
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts).Folders(TARGET_FOLDER_NAME)
If IsEmpty(olkFld) Then
Set olkFld = olkSes.GetDefaultFolder(olFolderContacts).Folders.Add(TARGET_FOLDER_NAME)
End If
'--> Delete the items from the Outlook folder
For lngCnt = olkFld.Items.Count To 1 Step -1
olkFld.Items.Remove lngCnt
Next
'--> Read the contacts downloaded from AD and add them to Outlook
arrTmp = objUsr.Items
For Each varTmp In arrTmp
arrItm = Split(varTmp, "|")
If (arrItm(1) = "") Or (arrItm(2) = "") Then
Else
Set olkCon = olkFld.Items.Add
olkCon.nickname = arrItm(0)
With olkCon
.LastName = arrItm(1)
.Firstname = arrItm(2)
.JobTitle = arrItm(3)
.Email1Address = arrItm(4)
.BusinessTelephoneNumber = arrItm(5)
.MobileTelephoneNumber = arrItm(6)
.OfficeLocation = arrItm(7)
.CompanyName = arrItm(8)
.Department = arrItm(9)
.BusinessAddressStreet = arrItm(10)
.BusinessAddressCity = arrItm(12)
.BusinessAddressState = arrItm(13)
.BusinessAddressPostalCode = arrItm(14)
.ManagerName = arrItm(15)
.BusinessFaxNumber = arrItm(16)
.HomeTelephoneNumber = arrItm(17)
.Business2TelephoneNumber = arrItm(18)
.WebPage = arrItm(19)
.Categories = "AutoUpdate"
.Save
End With
Set olkCon = Nothing
End If
Next
'--> Read the groups downloaded from AD and add them to Outlook
arrTmp = objGrp.Items
For Each varTmp In arrTmp
CopyGroup varTmp
Next
'--> Disconnect from Outlook
olkSes.Logoff
Set olkFld = Nothing
Set olkSes = Nothing
Set olkApp = Nothing
End If
'--> Clean up AD objects
adoRec.Close
Set adoRec = Nothing
adoCon.Close
Set adoCon = Nothing
'--> Clean up other objects
Set objUsr = Nothing
Set objGrp = Nothing
Set objAct = Nothing
Set objADRDSE = Nothing
'--> Notify the user that the script has finished then terminate processing
MsgBox "Synchronization complete.", vbInformation+vbOKOnly, SCRIPT_NAME
WScript.Quit
Sub CopyGroup(varPath)
Const olDistributionListItem = 7
Dim objGrp, olkGrp, olkRec, varMem, objAct
Set objGrp = GetObject(varPath)
Set olkGrp = olkFld.Items.Add(olDistributionListItem)
olkGrp.Subject = objGrp.displayName
'Set olkGrp = olkApp.CreateItem(olDistributionListItem)
For Each varMem In objGrp.member
Set objAct = GetObject("LDAP://" & varMem)
If objAct.mail <> "" Then
Set olkRec = olkSes.CreateRecipient(objAct.mail)
olkRec.Resolve
If olkRec.Resolved Then
olkGrp.AddMember olkRec
End If
End If
Next
olkGrp.Save
Set objGrp = Nothing
Set olkGrp = Nothing
Set olkRec = Nothing
Set objAct = Nothing
End Sub
ASKER
I have a distribution group with eight contacts in it. (Not users but contacts). Only one contact gets synced, not all eight. If i remove the one that is getting synced from the group, that one will get removed and another will be synced. Its like once one contact gets added it stops looking for more.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
that worked! thank you!
ASKER
one last question. Many of our offices can dial out from different phone numbers. In order for cell phones to recognize and pop the correct contact, all numbers have be to programmed into the contact, which could be up to 10 numbers. What do you think the best way to do this is. One option is putting numbers as Other, but maybe there is a better way.
An Outlook contact has 19 fields for phone numbers. An account/contact in AD appears to have about 15 phone number fields though only 5 are generally visible. I can have the script map any phone number field in AD to any phone number field in an Outlook contact. It's really just a matter of determining which phone number fields to use on both ends and then mapping them accordingly.
ASKER
I'm still planning to respond to this, but wanted to get the other question we have going finished first.
ASKER
I would like to award points and an answer.
ASKER
How do I mark the question as answered?
ASKER
David, thanks for much for this script! great work!
Do you still have the last bit of code we were using? It's in the PDF file but I'm unable to copy and paste it out. If you don't have it, then I'll type it up again.