dani
Goto Top

VBS - Kontakte im ADS anlegen

Guten Mittag zusammen,

ich habe heute eine Textdatei bekommen, in der lauter Kontakte drin stehen die ich im Exchange - Globales Adressbuch veröffentlicht werden müssen. Bei den Kontaken handelt es sich um externe Adressen. Nun könnte ich per Hand anlegen, jedoch sind es ca. 200 Stück. Praktikannten haben wir leider im Moment keine da. face-wink

Wie kann ich nun per VBS Script einen Kontakt anlegen, die E-Mailadresse als Hauptadressemarkieren und Vor- & Nachnamen angeben. In welche OU die Kontakte erstellt werden sollen, soll vorher abgefragt werden.

Aufbau einer Textdatei ist sicher auch von nöten:
müller tab christoph tab ch.mueller@seinedomain.de
....
System: Windows 2003 EE + Exchange 2003 EE => ServicePack 2
Im vorraus vielen Dank & und einen schönen Männertag! face-smile
Update:
17.05.2007 12:09 Uhr
Also jetzt habe ich nach Stunden doch noch ein kl. VBScript gefunden:
Set ou = GetObject("LDAP://ou=Benutzer,dc=firma,dc=de")  

Set mailcontact = ou.Create("contact", "cn=Mail-Contact")  
mailContact.mailNickName = "pfoeckeler-extern"  
mailContact.displayName = "Föckeler, Philipp (Extern)"  
mailContact.targetAddress = "philipp.foeckeler@cerrotorre.de"  
mailcontact.SetInfo
Der Kontakt wird erzeugt. Jedoch wird nicht die angegebene E-Mailadresse genommen. Es wurde ein Exchange - Postfach angelegt mit der Exchange-Domäne.


Gruß
Dani

Content-Key: 59212

Url: https://administrator.de/contentid/59212

Printed on: April 15, 2024 at 13:04 o'clock

Member: bastla
bastla May 17, 2007 at 10:15:51 (UTC)
Goto Top
Hallo Dani!

Vielleicht kannst Du damit etwas anfangen:
http://www.msxfaq.net/code/makecontact.htm
Create a Contact in Active Directory

Grüße
bastla

[Edit] @Dani: Sorry, hatte Dein Edit noch nicht gesehen ... [/Edit]
Member: Dani
Dani May 17, 2007 at 10:27:02 (UTC)
Goto Top
Hallo bastla!

Vielen Dank für die Links. Den 1. Link kenne ich schon, hat mir aber nichts gebracht. Den Inhalt vom 2. Link ist gleich wie mein Update. Dank dir trotzdemm...noch ne Idee??
Hier habe ich ein Link gefunden, aber der Code ist einfach zu hoch für mich:
http://www.msexchange.org/articles/Migrating-Contacts-Distribution-List ...


Gruß
Dani
Member: bastla
bastla May 17, 2007 at 10:29:35 (UTC)
Goto Top
Nachtrag:

Auffällig ist, dass in dem Beispiel bei dem ersten von mir angeführten Link ein Objekt "user", nicht "contact", erstellt wird. Allerdings habe ich keine Ahnung, ob das hier weiterhilft ...

Grüße
bastla
Member: Dani
Dani May 17, 2007 at 11:42:46 (UTC)
Goto Top
Hi!
Ne....leider nicht. Also ich hab's fast fertig. Ich brauche legendlich noch das Kommando, um unter "E-Mail Adressen" der Kontakteigenschaft die E-Mailadresse hinzuzufügen und als "Hauptadresse zu setzen.

Wie stelle ich es am Besten mit dem Auslesen der einzelnen Daten?? Datei öffen ist kein Thema, aber das auftrennen nach dem TAB macht mir Probleme. Funktioniert das auch mit der split Funktion?!


Gruß
Dani
Member: bastla
bastla May 17, 2007 at 11:55:31 (UTC)
Goto Top
Hallo Dani!

Ohne verfügbaren Exchange-Server bin ich leider Trockenschwimmer und damit keine wirkliche Hilfe ...

Was das Aufteilen angeht:
C = Split(Zeile, vbTab) 
sollte gehen ...

Grüße
bastla
Member: Dani
Dani May 17, 2007 at 12:03:41 (UTC)
Goto Top
Hallo bastla!
Danke...aber eben hat sich etwas neues ergeben. Und zwar wurde aus der Textdatei eine Exceltabelle. Sprich ich müsste nur noch die Zellen einer jedener Zeile auslesen. Jedoch habe ich das mit VBScript noch nie gemacht.

Aufbau Exceltabelle:
vorname |nachname | e-mailadresse | beschreibung


Gruß & ein fettes Danke
Dani
Member: bastla
bastla May 17, 2007 at 12:23:35 (UTC)
Goto Top
Hallo Dani!

Die unsportliche Variante (vor allem, wenn es ein einmaliger Vorgang sein sollte) wäre ein Speichern der Excel-Datei als ".csv", aber an einem Feiertag darf's schon auch einmal ein Script sein:
Set XL = WScript.CreateObject("Excel.Application")  
XL.Workbooks.Open "D:\Kontaktdaten.xls"  
i = 1 'Zeilennummer der ersten Datenzeile  
Do While XL.Worksheets(1).Cells(i,1).Value <> ""  
	Vorname = XL.Worksheets(1).Cells(i,1).Value
	Zuname = XL.Worksheets(1).Cells(i,2).Value
	email = XL.Worksheets(1).Cells(i,3).Value
	Beschr = XL.Worksheets(1).Cells(i,4).Value

	WScript.Echo Vorname & ", " & Zuname & ", " & email & ", " & Beschr  

	i = i + 1
Loop
XL.ActiveWorkbook.Saved = True
XL.Application.Quit
Die "WScript.Echo"-Zeile dient natürlich nur der Demonstration - im Prinzip kannst Du dort gleich das Erstellen des Kontaktes durchführen.

Grüße
bastla

[Edit] Natürlich würde es mit einem "With XL.Worksheets(1)"-Block schöner aussehen, aber man muss es ja nicht gleich übertreiben ... [/Edit]
Member: Dani
Dani May 17, 2007 at 12:33:03 (UTC)
Goto Top
Dank dir nochmal! Ja ich weiß, aber es kommt von oben runter. Vielleicht kennst du das Spiel. face-smile
So einfach kann es manchmal sein....Funktioniert so einwandfrei. Wenn das Script fertig ist, poste ich es natürlich gerne! face-smile


Gruß
Dani
Member: bastla
bastla May 17, 2007 at 12:44:53 (UTC)
Goto Top
Hallo Dani!

Noch eine Idee zum Eintragen der Mailadresse (aus dem etwas längeren Code bei http://www.msexchange.org/articles/Migrating-Contacts-Distribution-List ... abgeleitet):
Anstelle der Zeile mailContact.targetAddress = "philipp.foeckeler@cerrotorre.de" Deines Beispieles oben könntest Du noch
Set objRecip = mailContact
objRecip.MailEnable "SMTP:" & "philipp.foeckeler@cerrotorre.de"  
versuchen.

Grüße
bastla
Member: Dani
Dani May 17, 2007 at 13:13:08 (UTC)
Goto Top
So,
also bastla das war ein Volltreffer! Einfach genial von dir...Ich habe das Script auch schon durchsucht, aber nichts gefunden. So, jetzt hab ich auch Feierabend... face-smile Also Danke nochmal & einen schönen Vater-Tag (Männertag).
Das Script folgt Heute oder Morgen (versprochen)!! *gg*


Gruß
Dani
Member: Dani
Dani May 17, 2007 at 13:48:17 (UTC)
Goto Top
Jetzt habe ich noch eine kl. Zusatzaufgabe: Wenn nun ein Kontakt schon exstiert, bricht das Script automatisch ab und zeigt mir eine Meldung. Wie kann ich das am Besten realisieren, dass er dann den Datensatz überspringt und den nächsten macht?


Gruß
Dani
Member: bastla
bastla May 17, 2007 at 14:05:35 (UTC)
Goto Top
Hallo Dani!

Könnte so gehen: Nach dem Einlesen der Zeile aus Excel (und nach dem Set ou=...)
emailExists = False
For Each adcontact In ou
	If LCase(CStr(adcontact.mail)) = LCase(CStr(email)) Then
		emailExists = True
		Exit For
	End If
Next
If Not emailExists Then
	'anlegen: Set mailcontact = ou.Create(...  
	
End If

Grüße
bastla
Member: Dani
Dani May 17, 2007 at 15:22:43 (UTC)
Goto Top
Hi bastla!
So, jetzt klappts ohne Probleme! Vielen Dank....Wie versprochen, hier die Version 0.4:
'Allgemeine Informationen / Hinweise / ChangeLog  
'##########################################################################  
'Autor:	Dani  
'Aufagbe:	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("LDAP://ou=Kontakte,dc=familie-wydler,dc=local")  
	

'Ü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
Bei Fehler bitte ich euch, sag mir Bescheid! Danke...


Gruß
Dani