Aufgrund einer Anforderung eines Kundenauftrags mussten bei ĂĽber 600 Benutzern Mail-Weiterleitungen eingerichtet werden, damit die Nachrichten im alten sowie im neuen Mail-System verarbeitet werden. Aus diesem Grund mussten in der alten Umgebung eine entsprechende Anzahl von Mail-Kontakten angelegt werden. Da dieses manuell recht langwierig gewesen wäre, habe ich das folgende Skript von „Dani“ gefunden. Dieses muss einfach in eine VBS-Datei kopiert werden:
'########################################################################## 'Autor: Dani 'Aufgabe: Aus einer Exceltabelle im Exchange externe Kontakt erstellen 'Version: '0.1 - Namensgebung einheitlich dargestellt '0.2 - Dialogbox zur Abfrage der Exceltabelle eingebaut '0.3 - Überprüft, ob Kontakt schon vorhanden ist '0.4 - In der Abfrage, ob die E-Mailadresse schon AD vorhanden ist, war die Abfrage falsch. 'Variablen '########################################################################## Dim objobjExcel, objOpenDialog, objOU, objContact, objRecip Dim strVorname, strNachname, strEmail, strDesc ' Dialogbox - Auswahl der Exceltabelle, die eingelesen werden soll '########################################################################## do Set objOpenDialog = CreateObject("SAFRCFileDlg.FileOpen") intReturn = objOpenDialog.OpenFileOpenDlg If intReturn Then Else WScript.Echo "Script wird beendet!" WScript.Quit End If Loop While objOpenDialog.FileName = "" 'Die entsprechende Datei wird geöffent '########################################################################## Set objExcel = WScript.CreateObject("Excel.Application") objExcel.Workbooks.Open objOpenDialog.FileName 'Zeilennummer der ersten Datenzeile i = 2 Do While objExcel.Worksheets(1).Cells(i,3).Value <> "" strVorname = objExcel.Worksheets(1).Cells(i,1).Value strNachname = objExcel.Worksheets(1).Cells(i,2).Value strEmail = objExcel.Worksheets(1).Cells(i,3).Value strDesc = objExcel.Worksheets(1).Cells(i,4).Value ' Organisationseinheit, in der ide Kontake erzeugt werden sollen Set objOu = GetObject("<a href="ldap://ou=Kontakte,dc=familie-wydler,dc=local">LDAP://ou=Kontakte,dc=domain,dc=local</a>") 'Überprüfen, ob eine Kontakt schon vorhanden ist und setzt dem entsprechend die Variable ' True - E-Mailadresse existiert bereits ' False - E-Mailadresse nicht vorhanden emailExists = False For Each adcontact In objOu If LCase(CStr(adcontact.targetAddress)) = LCase(CStr("SMTP:"& strEmail)) Then emailExists = True Exit For End If Next 'Erzeugt die einzelnen Kontakte If Not emailExists Then 'Erzeugt die einzelnen Kontakte Set objContact = objOu.Create("contact", "cn="& strVorname &" "& strNachname) objContact.mailNickName = strVorname &" "& strNachname objContact.displayName = strVorname &" "& strNachname objContact.targetAddress = strEmail objContact.givenName = strVorname objContact.sn = strNachname 'Setzt nur die Beschreibung, wenn das Excelfeld nicht leer ist If strDesc <> "" Then objContact.description= strDesc End If 'Hinterlegt im Reiter "E-Mail Adressen" der Benutzereigenschaften die E-Mailadresse Set objRecip = objContact objRecip.MailEnable "SMTP:" & strEmail objContact.SetInfo Else WScript.echo "Doppelter Kontakt - "& strVorname &", "& strNachname &"!" End If 'Nächste Excelzeile i = i + 1 Loop 'Setzt das "gespeichert" - Flag. Somit entfällt die Abfrage beim Beenden objExcel.ActiveWorkbook.Saved = True 'Exceltabelle schließen / beenden objExcel.Application.Quit 'Script beenden '########################################################################## WScript.Echo "Kontakte erfolgreich angelegt!" WScript.Quit
Quelle: http://www.administrator.de/index.php?content=59212
Nun muss man im Skript nur die OU angeben, in der die Kontakte erstellt werden sollen und die Exceltabelle vorbereiten nach dem Design:
- Spalte 1: Vorname
- Spalte 2: Nachname
- Spalte 3: E-Mail-Adresse
- Spalte 4: Beschreibung (falls benötigt)
Die Tabelle sollte allerdings dieses nicht als ĂśBerschriften haben, da diese sonst auch als Kontakt angelegt werden.