Outlook: Globale Adressliste importieren

VoIP ist ne schön Sache, vor allem da man damit Festnetz Anrufe auf das Handy umleiten kann. Was jedoch unschön ist, ist die Tatsache, dass anschließend Firmennummern nicht aufgelöst werden und wer kennt schon jedes Suffix einem Mitarbeiter zuordnen?

Daher bietet es sich an, die Mitarbeiter mit Telefonnummer aus dem AD in Outlook zu importieren:

Get-ADUser -Filter *  -Properties * | where {$_.DistinguishedName -like "*OU=Users*"} | where {$_.OfficePhone -eq $null} | where {$_.sn -eq $null} |select sn,GivenName,City,Company,Department,mail,OfficePhone,Fax,mobile |Export-Csv contacts.csv -Delimiter ","

Da Ergebnis ist dann eine CSV-Datei in der nun noch die ersten beiden Zeilen durch die folgende ersetzt werden müssen:

"Nachname","Vorname","Ort geschäftlich","Firma","Abteilung","E-Mail-Adresse","Telefon Firma","Fax geschäftlich","Mobiltelefon"

Anschließend kann die CSV-Datei in einen Kontak-Unterordner imortiert werden welche per ActiveSync automatisch auf das Smartphone synchronisiert wird.

Wer anschließend die Kontakte auch noch alle mit einem Firmenlogo versehen möchte, damit man Firmenanrufe im Display schneller identifizieren kann, kann dies per VBA. Wer seine GAL-Kontakte nicht in einem Unterordner unterhalb der Kontakte abgespeichert hat, braucht nur die rot markierte Stelle zu entfernen.

Sub test()
Dim myOlApp As Outlook.Application
Dim myNamespace As Outlook.NameSpace
Dim myContacts As Outlook.Items
Dim myItems As Outlook.Items
Dim myItem As Object
Dim olFolder As Outlook.MAPIFolder
Dim myContact As Outlook.ContactItem
Dim strPhoto As String

  Set myOlApp = Outlook.Application
  Set myNamespace = myOlApp.GetNamespace("MAPI")
  Set olFolder = myNamespace.GetDefaultFolder(olFolderContacts)
  Set myContacts = olFolder.Folders("GAL Import").Items

  For Each myItem In myContacts
    If (myItem.Class = olContact) Then

      Set myContact = myItem
      strPhoto = "d:firmenlogo.png"

      If Len(Dir(strPhoto)) > 0 Then
        With myContact
          .AddPicture strPhoto
          .Save
        End With
      End If
    ' MsgBox myContact.FullName
     End If
  Next myItem

End Sub

Quelle: http://www.jpsoftwaretech.com/add-photos-to-contacts-in-bulk-using-vba-in-outlook/