Laurence School [Helpdesk]

Use a VBScript to automatically import contact portraits into Outlook.

• Open Outlook and navigate to a contact folder
• Open the VBA editor inside Outlook (Alt + F11)
  
• Expand the MSO object to ThisOutlookSession
• Run the script below
  

Be sure to edit the path value for the string variable strPhoto. With the current setting, the pictures folder would need to be located at the root level of the C: drive and images would need to be in .jpg format. Example path for one image-- "C:\photos\Jesus Elias.jpg"

Note: All images should be under 600x600 and set to 72dpi for them to show up on mobile devices.

Public Sub UpdateContactPhoto()
    Dim myOlApp As Outlook.Application
    Dim myNamespace As Outlook.NameSpace
    Dim myContacts As Outlook.Items
    Dim myItems As Outlook.Items
    Dim myItem As Object
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNamespace = myOlApp.GetNamespace("MAPI")

    Set myContacts = myOlApp.ActiveExplorer.CurrentFolder.Items

    Dim fs As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    For Each myItem In myContacts
        If (myItem.Class = olContact) Then
            Dim myContact As Outlook.ContactItem
            Set myContact = myItem

            Dim strPhoto As String

            'path to images. FullName format in "first last.jpg"
                strPhoto = "C:\photos\" & myContact.FullName & ".jpg"

            'for testing. needs macro notifications turned on
            'MsgBox (strPhoto)

            If fs.FileExists(strPhoto) Then
                myContact.AddPicture strPhoto
                myContact.Save
            End If
        End If
    Next
End Sub