viktorhim
Goto Top

Vbs - Attribute des Eingeloggten Users aus AD auslesen, laut vorlage in Outlook Sig übernehmen

Hallo,
Das Script soll erkennen welcher User sich an dem PC einloggt und Automatisch aus der AD verschiedene Werte auslesen, diese (laut meiner vorlage aus einer txt rft htm) in eine Outlook-Signature abspeichern.


@SlainteMhath Du hast ja recht :D


Update 2: Soweit sind jetzt alle fehler Behoben und das Sript "funktioniert" soweit es soll. Durch Updates, unter anderem im "FileSystemObject = FSO", mussten mehrere sachen überarbeitet werden; die mir auch nicht bekannt waren & somit fehler verursacht haben. Das Script läuft jetzt soweit auf meinem Rechner und wird vorraussichtlich Morgen zum Test kommen.

Durch änderung der FSO, muss mit 1, 2 nach der variablen deklariert werden; wobei man
 Const ForReading = 1, ForWriting = 2 
angeben muss, da ForReading Standartmässig 0 ist, dieses war mir aus meinem Studium auch nicht bekannt. Quelle: http://support.microsoft.com/kb/300982/de

Update 3: Das Script macht was es soll, funktioniert bei uns 1A! Wird jetzt uns einiges an Zeit ersparen, immer Namen position Gruppe usw in den Vorlagen zu bearbeiten.
Nochmals recht Herzlichen Dank!


Hier das Überarbeitete Script:
option explicit

'Laden der zu benötigten Variablen  
dim WshShell
dim strSig, objDomain, strActiveUser, objObject, objUser, OU, strFileName, strUserName
dim strFiles(), strItem, strClnReplacement, strFile, strSigName
dim objFSO, objFile, objWord, objEmailOptions, objSignatureObject
redim strFiles(2)

'Laden des Eingeloggten Users  
set WshShell = WScript.CreateObject("WScript.Shell")  
strUserName = WshShell.ExpandEnvironmentStrings("%USERNAME%")  
'Echo wurde zu Testzwecken deklariert und kann auskommentiert werden  
WScript.Echo strUserName

'Definition der Vorlagendateien  
strFiles(0) = "C:\Users\ViktorHim\Desktop\Sig\Signature_test.htm"  
strFiles(1) = "C:\Users\ViktorHim\Desktop\Sig\Signature_test.rtf"  
strFiles(2) = "C:\Users\ViktorHim\Desktop\Sig\Signature_test.txt"  


'Platzhalter in allen Dateien gegen personalisierte Werte austauschen  
for each strFile in strFiles
	Const ForReading = 1
    set objFSO = CreateObject("Scripting.FileSystemObject")  
    set objFile = objFSO.OpenTextFile(strFile, 1)

    'Einlesen des Dateiinhaltes in die Variable strSig  
    strSig = objFile.ReadAll
    objFile.Close
	
    for each strItem in ReturnArrayOfPlaceholders(strFile)
        '"Reinigung" des Placeholders (entfernen von den Steuerzeichen @_ und _@) um den AD-Feldnamen  
        'in Reinform zu gewinnnen.  
        'Bsp.: aus @_givenName_@ wird givenName  
        strClnReplacement=Replace(strItem,"@_","")  
        strClnReplacement=Replace(strClnReplacement,"_@","")  
        if len(strClnReplacement) > 0 then
          'Ersetzen des Placeholders durch die personalisierten AD Daten  
          'Bsp.: @_givenName_@ wird zu Mustermann  
          strSig = Replace(strSig, strItem, GetADData(strClnReplacement, strUserName))
        end if
    Next
	
    
	'Den Namen der Signatur merken  
    strSigName = objFSO.GetBaseName(strFile)
	
    'Wegschreiben der personalisierten Signatur in eine Datei  
    set objFSO = CreateObject("Scripting.FileSystemObject")  
    strFileName = WshSysEnv & "MicrosoftSignatures" & strFile  
	strFileName = "C:\Users\%USERNAME%\AppData\Roaming\Microsoft\Signatures" & strUserName.Username & "\Anwendungsdaten\Microsoft\Signatures\" & strFile  
    set objFile = objFSO.CreateTextFile(strFileName, true)
    objFile.Write strSig    
    objFile.Close
next


'neue Signatur in Outlook aktivieren  
Set objWord = CreateObject("Word.Application")  
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
objSignatureObject.NewMessageSignature = strSigName
objSignatureObject.ReplyMessageSignature = strSigName
objWord.Quit


'------------------------Funktionen---------------------------------  


'Diese Funktion gibt alle Placeholder einer übergebenen Datei in einem Array zurück  

Function ReturnArrayOfPlaceholders(strFile)
    Dim strReplacements(),i,strSigLine, intPos, intPosSpace,strItem, objFSO_Func, objFile_Func
    ReDim strReplacements(50)
    i = 0
    Set objFSO_Func = CreateObject("Scripting.FileSystemObject")  
    Set objFile_Func = objFSO.OpenTextFile(strFile)
    Do Until objFile_Func.AtEndOfStream
      strSigLine = objFile_Func.ReadLine
      intPos = 0
      intPos = InStr(strSigLine, "@_")  
      Do While intPos > 0
          intPosSpace = InStr(intPos, strSigLine, "_@")  
          strItem = Mid(strSigLine, intPos, intPosSpace - intPos + 2)
          strReplacements(i) = strItem
          intPos = InStr(intPos + 1, strSigLine, "@_")  
          i = i + 1
      Loop
    Loop
    objFile_Func.Close
    ReDim Preserve strReplacements(i)
    ReturnArrayOfPlaceholders = strReplacements
End Function


'Diese Funktion gibt für den übergebenen sAMAccountName den Inhalt des  
'übergebenen AD-Feldes (strADFieldName) zurück.  
'strADFieldname kann jedes Feld des Userobjektes im AD sein.   

Function GetADData(strADFieldName, strUserName)
    Dim objConnection, objCommand, objRecordSet
    'Wie viele Ebenen im AD gesucht werden soll  
    Const ADS_SCOPE_SUBTREE = 2
    
	'Verbindung zu AD herstellen  
	Set objConnection = CreateObject("ADODB.Connection")  
	Set objCommand = CreateObject("ADODB.Command")  
	objConnection.Open "Provider=ADsDSOObject;"  
	objCommand.ActiveConnection = objConnection
	objCommand.CommandText = "SELECT " & strADFieldName & " FROM " & _  
	"'LDAP://OU=Irrenhau,OU=da,DC=was,DC=com' " & _  
	"WHERE samAccountName = '" & strUserName & "'"  
	objCommand.Properties("SearchScope") = ADS_SCOPE_SUBTREE  
	Set objRecordSet = objCommand.Execute
	GetADData = objRecordSet.Fields(strADFieldName)
	End Function

Danke nochmals an @Biber & @SlainteMhath für die Hilfestellung!

@Biber Jetzt habe ich erst deinen Post verstanden :D ; ist auch schon recht spät, Gute Nacht.


So long

Viktor

Content-ID: 208624

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

Ausgedruckt am: 06.11.2024 um 01:11 Uhr

SlainteMhath
SlainteMhath 25.06.2013 um 15:52:37 Uhr
Goto Top
Moin,

bitte formatieren den code mit den entsprechenden Tags, so ist das kaum lesbar im Browser. Und dann verrat uns doch WAS für eine Fehlkermeldung kommt und v.A.WO (=in welcher Zeile)

lg,
Slainte
ViktorHim
ViktorHim 25.06.2013 um 18:23:32 Uhr
Goto Top
Hallo,
habs nochmal überarbeitet. Fehlermeldung stand schon da, aber bei dem durcheinander bestimmt übersprungen ;)

Lg
Viktor
Biber
Biber 25.06.2013 um 21:43:09 Uhr
Goto Top
Moin VictorHim,

willkommen im Forum.

Das Naheliegendste bei dieser Fehlermeldung wäre doch mal eine Debug-Ausgabe des dort ankommendenden SQL-Statements.

Also so etwas
Function GetADData(strADFieldName, strActiveUser)
    Dim objConnection, objCommand, objRecordSet

    Const ADS_SCOPE_SUBTREE = 2

    Set objConnection = CreateObject("ADODB.Connection")  
    Set objCommand = CreateObject("ADODB.Command")  
    objConnection.Provider = ("ADsDSOObject")  
    objConnection.Open "Active Directory Provider"  
    objCommand.ActiveConnection = objConnection
    objCommand.CommandText = "SELECT " & strADFieldName & " FROM " & _  
        "'LDAP://dc=contoso,dc=msft' " & _  
            "WHERE samAccountName = '" & strActiveUser & "'"  
    objCommand.Properties("SearchScope") = ADS_SCOPE_SUBTREE  
' Anfang Ausgabe zur Fehlersuche:  
Wscript.echo "[" &  objCommand.CommandText &"]"  
' Ende Ausgabe zur Fehlersuche       

Set objRecordSet = objCommand.Execute
' Und hier sollte wenigstens abgefangen werden, ob zufällig  
' ein leeres ResultSet zurückkam - das ist einfach das Mindestmass an Stil.  

If not  objRecordSet.Eof
    GetADData = objRecordSet.Fields(strADFieldName)
Else
 ' Fehlerbehandlung, z.B eine Zeile Logfile für den Admin  
End if

Was wird denn für ein Statement erzeugt?

Gibt ja nur die Möglcihkeiten, dass "demUserSeinName" oder "demUserSeinFeld" nicht gefunden werden.

Grüße
Biber
SlainteMhath
SlainteMhath 26.06.2013 um 08:45:10 Uhr
Goto Top
@ViktorHim
Danke fürs formatieren face-smile

Gibt ja nur die Möglcihkeiten, dass "demUserSeinName" oder "demUserSeinFeld" nicht gefunden werden.
Dem ist nichts mehr hinzuzufügen face-smile
ViktorHim
ViktorHim 26.06.2013 um 20:18:36 Uhr
Goto Top
Danke & werde ich Morgen mal ausprobieren. Heute leider keine zeit gehabt daran zu arbeiten.

@SlainteMhath Bitte ;D
Biber
Biber 03.07.2013 um 18:23:00 Uhr
Goto Top
Moin ViktorHim,

Zitat von @ViktorHim: am 26.06.2013 um 20:18 Uhr
Danke & werde ich Morgen mal ausprobieren. Heute leider keine zeit gehabt daran zu arbeiten.
Lass mich raten - und dann ist irgendetwas Ungeplantes passiert und seitdem hältst du dich im Terminal-Bereich des BER-Flughafens auf und schreibst jetzt mit dem Word-Serienbrief-Feature Asylanträge..


Anders gefragt: ist noch ein Rest Leben in diesem Beitrag oder kann ich den kompostieren?

Grüße
Biber
ViktorHim
ViktorHim 03.07.2013 aktualisiert um 22:58:10 Uhr
Goto Top
Abend @Biber

Lass dieses noch bitte stehen, werde mich Morgen melden. Hatten einen kompletten Serverausfall für 3 Tage um das sich unser Team kümmern musste.


Update wurde gepotet

Mfg
Viktor