Verteilerliste mit ca. externen eMail Adressen

'Variablen  
'##########################################################################  
Dim objobjExcel, objOU, objContact, objRecip
Dim strVorname, strNachname, strEmail, strDesc, strKat


'Die entsprechende Datei wird geöffent  
'##########################################################################  
'Pfad zur Exceldatei  
Set objExcel = WScript.CreateObject("Excel.Application")  
objExcel.Workbooks.Open "A:\dasdadsa\dsadsada\Globale Kontakte.xls"  

'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
	strKat		= objExcel.Worksheets(1).Cells(i,5).Value
	
	'WScript.echo "Kontakt - "& strNachname &", "& strVorname &"!"  
	
	' Organisationseinheit, in der ide Kontake erzeugt werden sollen  
	Set objOu = GetObject("LDAP://ou=Kontakte,ou=exchange, ou=suedwest,ou=vm,ou=de,dc=labor,dc=wan")  
	
	'**************************************************************************************************  
	'Hinzufügen von Kontakten  
	'**************************************************************************************************  
	If LCase(CStr(strKat)) = LCase(Cstr("A")) Then  
		'Ü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.sn)) = LCase(CStr(strNachname)) 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 = strNachname &", "& strVorname  
			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
		End If
	End If
	
	'**************************************************************************************************  
	'Updaten von Kontakten  
	'**************************************************************************************************  
	If LCase(CStr(strKat)) = LCase(Cstr("U")) Then  
	
	End If
	'**************************************************************************************************  
	'Löschen von Kontakten  
	'**************************************************************************************************  
	If LCase(CStr(strKat)) = LCase(Cstr("D")) Then  
		objOU.Delete "contact", "cn="& strVorname &" "& strNachname  
		objExcel.ActiveSheet.Cells(3,5).Value = "test"  
		objExcel.ActiveWorkbook.Saved = True

	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

Set objOu = GetObject("LDAP://ou=Kontakte,ou=exchange, ou=suedwest,ou=vm,ou=de,dc=labor,dc=wan")