Signature standardisée dans outlook via paramètres active directory de l'utilisateur

Télécharger le projet

Commenter

Description

Ecriture d'une signature pour Outlook (2002 et 2003 testés) afin que tous les utilisateur d'une même organisation Active Directory aient la même forme.

Source / Exemple :

'---------------------------------------------------------------------------------------------------------
'Définition de la signature Outlook  via paramètres utilisateur Active Directory
'
'   ### PREMIER SCRIPT ### LE SECOND SE TROUVE A LA FIN DE CELUI-CI ### 
'---------------------------------------------------------------------------------------------------------
'
'
'Définition des variables et vérification de l'existance du dossier ....\Microsoft\Signatures
	set netw=createobject("wscript.network")
	Set FileSystem = WScript.CreateObject("Scripting.FileSystemObject")
	set oshell = createobject("wscript.shell")
	if not FileSystem.folderexists (oshell.expandenvironmentstrings("%userprofile%") & "\Application Data\Microsoft\Signatures") then
		FileSystem.CreateFolder(oshell.expandenvironmentstrings("%userprofile%") & "\Application Data\Microsoft\Signatures")
	End If
	Set OutPutFileTxt = FileSystem.CreateTextFile(oshell.expandenvironmentstrings("%userprofile%") & "\Application Data\Microsoft\Signatures\Ma_Signature.txt", True)
	Set OutPutFileHtml = FileSystem.CreateTextFile(oshell.expandenvironmentstrings("%userprofile%") & "\Application Data\Microsoft\Signatures\Ma_Signature.htm", True)
'Suppression du fichier RTF si existant
	if FileSystem.fileexists (oshell.expandenvironmentstrings("%userprofile%") & "\Application Data\Microsoft\Signatures\Ma_Signature.rtf") then
		FileSystem.DeleteFile(oshell.expandenvironmentstrings("%userprofile%") & "\Application Data\Microsoft\Signatures\Ma_Signature.rtf")
	End If
'Send START Message
	WScript.Echo "Creation signature Outlook en cours ... Veuillez patientez, s'il vous plait"
'Définition des OU Active Directory
'
'
'
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'!!!! xxxx = A définir suivant votre configuration AD !!!!!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'
'
'
	Set oContainer=GetObject("LDAP:// ou=xxxx,dc=xxxx,dc=xxxx,dc=com")
	EnumerateUsers oContainer
'
'
'
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'!!!! xxxx = A définir suivant votre configuration AD !!!!!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'
' Si plusieurs OU de recherche
'
'
'	Set oContainer=GetObject("LDAP:// ou=xxxx,dc=xxxx,dc=xxxx,dc=com")
'	EnumerateUsers oContainer
'
'
'
'
'Message de fin de procédure sur Erreur
	WScript.Echo "Erreur: utilisateur inconnu ou mauvaise definition Active Directory ..."
	WScript.Quit(0) 
'Sub Programme de recherche "EnumerateUsers"
	Sub EnumerateUsers(oCont)
	Dim oUser
	For Each oUser In oCont
		Select Case LCase(oUser.Class)
			Case "user"
			If oUser.sAMAccountName=netw.username Then
'Affichage des paramètres de l'utilisateur
			BtnCode = oshell.Popup("Nom: " & oUser.description & chr(13) & "Title: " &oUser.title & chr(13) & "Departement: " & oUser.department & chr(13) & "Adresse: " &  oUser.postOfficeBox & ", " & oUser.streetAddress & ", " & oUser.postalCode & " " & oUser.l & chr(13) & "Phone: " & oUser.telephoneNumber & chr(13) & "Mobil: " & oUser.mobile & chr(13) & "Fax: " & oUser.facsimileTelephoneNumber & chr(13) & "Mail: " & oUser.mail & chr(13) & chr(13), 0, "Voulez-vous continuer: ?", 4 + 64)
				If BtnCode=6 then
' Création du fichier au format TXT
					OutPutFileTxt.WriteLine "Salutations / Best regards"
					OutPutFileTxt.WriteLine " "
					OutPutFileTxt.WriteLine oUser.description
					OutPutFileTxt.WriteLine "--"
					OutPutFileTxt.WriteLine oUser.title
					OutPutFileTxt.WriteLine oUser.department
					OutPutFileTxt.WriteLine oUser.postOfficeBox & ", " & oUser.streetAddress & ", " & oUser.postalCode & " " & oUser.l
					If Not IsEmpty(oUser.telephoneNumber) Then
						OutPutFileTxt.WriteLine "Phone  " & oUser.telephoneNumber
					End If
					If Not IsEmpty(oUser.mobile) Then
						OutPutFileTxt.WriteLine "Mobile " & oUser.mobile
					End If
					If Not IsEmpty(oUser.facsimileTelephoneNumber) Then
						OutPutFileTxt.WriteLine "Fax    " & oUser.facsimileTelephoneNumber
					End If
					OutPutFileTxt.WriteLine "Mailto:" & oUser.mail
					OutPutFileTxt.WriteLine "http://VotresiteWEB"
					OutPutFileTxt.Close
'Création du fichier au format HTML
					OutPutFileHtml.WriteLine "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">"
					OutPutFileHtml.WriteLine "<HTML><HEAD>"
					OutPutFileHtml.WriteLine "<META http-equiv=Content-Type content=""text/html; charset=windows-1252"">"
					OutPutFileHtml.WriteLine "<META content=""MSHTML 6.00.2800.1459"" name=GENERATOR></HEAD>"
					OutPutFileHtml.WriteLine "<BODY>"
					OutPutFileHtml.WriteLine "<DIV align=left>"
					OutPutFileHtml.WriteLine "<TABLE id=table1"
					OutPutFileHtml.WriteLine "style=""BORDER-TOP-WIDTH: 0px; BORDER-LEFT-WIDTH: 0px; BORDER-BOTTOM-WIDTH: 0px; BORDER-RIGHT-WIDTH: 0px"""
					OutPutFileHtml.WriteLine "height=194 width=500 border=1>"
					OutPutFileHtml.WriteLine "  <TBODY>"
					OutPutFileHtml.WriteLine "  <TR>"
					OutPutFileHtml.WriteLine "    <TD"
					OutPutFileHtml.WriteLine "    style=""BORDER-RIGHT: medium none; PADDING-RIGHT: 0px; BORDER-TOP: medium none; PADDING-LEFT: 0px; PADDING-BOTTOM: 0px; "
					OutPutFileHtml.WriteLine "    BORDER-LEFT: medium none; PADDING-TOP: 0px; BORDER-BOTTOM: medium none"""
					OutPutFileHtml.WriteLine "    vAlign=bottom><SPAN lang=fr><FONT face=Arial size=2>Salutations / Best regards<BR>"
					OutPutFileHtml.WriteLine "<BR>"
					OutPutFileHtml.WriteLine "<FONT face=Arial size=2>" & oUser.description & "</FONT><BR>"
					OutPutFileHtml.WriteLine "<FONT face=Arial size=2>--</FONT><BR>"
					OutPutFileHtml.WriteLine "<FONT face=Arial size=2>" & oUser.title & "</FONT><BR>"
					OutPutFileHtml.WriteLine "<FONT face=Arial size=2>" & oUser.department & "</FONT><BR>"
					OutPutFileHtml.WriteLine "<FONT face=Arial size=2>" & oUser.postOfficeBox & ", " & oUser.streetAddress & ", " & oUser.postalCode & " " & oUser.l & "</FONT><BR>"
					If Not IsEmpty(oUser.telephoneNumber) Then
						OutPutFileHtml.WriteLine "<FONT face=Arial size=2>Phone " & oUser.telephoneNumber & "</FONT><BR>"
					End If
					If Not IsEmpty(oUser.mobile) Then
						OutPutFileHtml.WriteLine "<FONT face=Arial size=2><FONT face=Arial size=2>Mobile " & oUser.mobile & "</FONT><BR>"
					End If
					If Not IsEmpty(oUser.facsimileTelephoneNumber) Then
						OutPutFileHtml.WriteLine "<FONT face=Arial size=2>Fax   " & oUser.facsimileTelephoneNumber & "</FONT><BR>"
					End If
					OutPutFileHtml.WriteLine "<FONT face=Arial size=2><A href=""mailto:"
					OutPutFileHtml.WriteLine oUser.mail
					OutPutFileHtml.WriteLine """>mailto:" & oUser.mail & "</A></FONT><BR>"
					OutPutFileHtml.WriteLine "      </SPAN><A href=""http://votresiteWEB""><SPAN"
					OutPutFileHtml.WriteLine "      lang=fr><U><FONT face=Arial color=#0000ff"
					OutPutFileHtml.WriteLine "      size=2>http://votresiteWEB</FONT></U></SPAN></A></P></TD>"
					OutPutFileHtml.WriteLine "      </TR></TBODY></TABLE></DIV></BODY></HTML>"
					OutPutFileHtml.Close
'Message de FIN normale de la procédure
					WScript.Echo "Définition signature terminée"
					WScript.Quit(0) 
				else
'Message de d'ABANDON de la procédure
					WScript.Echo "Procédure annulée"
					WScript.Quit(0) 
				End If
			End If
			Case "organizationalunit", "container"
				EnumerateUsers oUser
		End Select
	Next
	End Sub
'
' Fin de la première version
'

'########################################################################
'#                                                                      #
'# Automatic Outlook Signature with LDAP Parameters                     #
'#                                                                      #
'########################################################################
'
'Find the current LDAP Name
'
'#############################
Set oRootDSE = GetObject("LDAP://RootDSE")
Set oShell = WScript.CreateObject("WScript.Shell")
sUserName = oShell.Environment("PROCESS").Item("username")
Const ADS_PROPERTY_CLEAR = 1
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
strDNSDomain = oRootDSE.Get("defaultNamingContext")
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_1779, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
strNetBIOSDomain = Left(strNetBIOSDomain, Len(strNetBIOSDomain) - 1)
strUserNTName = Trim(LogonAccount)
objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSDomain & "\" & strUserNTName
If Err.Number <> 0 Then
	On Error GoTo 0
	Wscript.Echo "ERROR: Login not found in Active Directory: " & strUserNTName 
Else
	On Error GoTo 0
	strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
	LDAP_Name = "LDAP://" & strUserDN 
End If 
'#############################
'
'Find the current User in this LDAP
'
'#############################
On error resume next
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
objCommand.CommandText = "SELECT adspath FROM '" & LDAP_Name & "' WHERE objectCategory='user' AND sAMAccountName='" & sUserName & "'"
Set objRecordSet = objCommand.Execute
if (objRecordset.Fields("adspath") <> "") then 
	GetAdsPath = objRecordset.Fields("adspath")
end if
objConnection.Close
LDAP_Path_User = GetAdsPath
'#############################
'
'Wrtite files for this Outlook Signature
'
'#############################
Set oUser=GetObject(LDAP_Path_User)
Set oShell = WScript.CreateObject("WScript.Shell")
Set FileSystem = WScript.CreateObject("Scripting.FileSystemObject")
if not FileSystem.folderexists (oshell.expandenvironmentstrings("%userprofile%") & "\Application Data\Microsoft\Signatures") then
	FileSystem.CreateFolder(oshell.expandenvironmentstrings("%userprofile%") & "\Application Data\Microsoft\Signatures")
End If
Set OutPutFileTxt = FileSystem.CreateTextFile(oshell.expandenvironmentstrings("%userprofile%") & "\Application Data\Microsoft\Signatures\efqm.txt", True)
Set OutPutFileHtml = FileSystem.CreateTextFile(oshell.expandenvironmentstrings("%userprofile%") & "\Application Data\Microsoft\Signatures\efqm.htm", True)
if FileSystem.fileexists (oshell.expandenvironmentstrings("%userprofile%") & "\Application Data\Microsoft\Signatures\efqm.rtf") then
	FileSystem.DeleteFile(oshell.expandenvironmentstrings("%userprofile%") & "\Application Data\Microsoft\Signatures\efqm.rtf")
End If
'=============================
'File with extension .TXT
'=============================
OutPutFileTxt.WriteLine " "
OutPutFileTxt.WriteLine "Salutations / Best regards"
OutPutFileTxt.WriteLine " "
OutPutFileTxt.WriteLine oUser.description
OutPutFileTxt.WriteLine "--"
OutPutFileTxt.WriteLine oUser.company
OutPutFileTxt.WriteLine oUser.title
OutPutFileTxt.WriteLine oUser.department
OutPutFileTxt.WriteLine oUser.postOfficeBox & ", " & oUser.streetAddress & ", " & oUser.postalCode & " " & oUser.l
If Not IsEmpty(oUser.telephoneNumber) Then
	OutPutFileTxt.WriteLine "Phone	" & oUser.telephoneNumber
End If
If Not IsEmpty(oUser.mobile) Then
	OutPutFileTxt.WriteLine "Mobile " & oUser.mobile
End If
If Not IsEmpty(oUser.facsimileTelephoneNumber) Then
	OutPutFileTxt.WriteLine "Fax		" & oUser.facsimileTelephoneNumber
End If
OutPutFileTxt.WriteLine "Mailto:" & oUser.mail
'
'
'Put your WEB Site instead of www.xxxxxxxxx.com
'
'
OutPutFileTxt.WriteLine "http://www.xxxxxxxxx.com.com"
OutPutFileTxt.Close
'=============================
'File with extension .HTM
'=============================
OutPutFileHtml.WriteLine "<!DOCTYPE HTML PUBLIC ""-//W3C//DTD HTML 4.0 Transitional//EN"">"
OutPutFileHtml.WriteLine "<HTML><HEAD>"
OutPutFileHtml.WriteLine "<META http-equiv=Content-Type content=""text/html; charset=windows-1252"">"
OutPutFileHtml.WriteLine "<META content=""MSHTML 6.00.2800.1459"" name=GENERATOR></HEAD>"
OutPutFileHtml.WriteLine "<BODY>"
OutPutFileHtml.WriteLine "<DIV align=left>"
OutPutFileHtml.WriteLine "<TABLE id=table1"
OutPutFileHtml.WriteLine "style=""BORDER-TOP-WIDTH: 0px; BORDER-LEFT-WIDTH: 0px; BORDER-BOTTOM-WIDTH: 0px; BORDER-RIGHT-WIDTH: 0px"""
OutPutFileHtml.WriteLine "height=194 width=500 border=1>"
OutPutFileHtml.WriteLine "	<TBODY>"
OutPutFileHtml.WriteLine "	<TR>"
OutPutFileHtml.WriteLine "		<TD"
OutPutFileHtml.WriteLine "		style=""BORDER-RIGHT: medium none; PADDING-RIGHT: 0px; BORDER-TOP: medium none; PADDING-LEFT: 0px; PADDING-BOTTOM: 0px; "
OutPutFileHtml.WriteLine "		BORDER-LEFT: medium none; PADDING-TOP: 0px; BORDER-BOTTOM: medium none"""
OutPutFileHtml.WriteLine "		vAlign=bottom><SPAN lang=fr>"
OutPutFileHtml.WriteLine "<BR>"
OutPutFileHtml.WriteLine "<FONT face=Arial size=2>Salutations / Best regards<BR>"
OutPutFileHtml.WriteLine "<BR>"
OutPutFileHtml.WriteLine "<FONT face=Arial size=2>" & oUser.description & "</FONT><BR>"
OutPutFileHtml.WriteLine "<FONT face=Arial size=2>--</FONT><BR>"
OutPutFileHtml.WriteLine "<FONT face=Arial size=2>" & oUser.company & "</FONT><BR>"
OutPutFileHtml.WriteLine "<FONT face=Arial size=2>" & oUser.title & "</FONT><BR>"
OutPutFileHtml.WriteLine "<FONT face=Arial size=2>" & oUser.department & "</FONT><BR>"
OutPutFileHtml.WriteLine "<FONT face=Arial size=2>" & oUser.postOfficeBox & ", " & oUser.streetAddress & ", " & oUser.postalCode & " " & oUser.l & "</FONT><BR>"
If Not IsEmpty(oUser.telephoneNumber) Then
	OutPutFileHtml.WriteLine "<FONT face=Arial size=2>Phone " & oUser.telephoneNumber & "</FONT><BR>"
End If
If Not IsEmpty(oUser.mobile) Then
	OutPutFileHtml.WriteLine "<FONT face=Arial size=2><FONT face=Arial size=2>Mobile " & oUser.mobile & "</FONT><BR>"
End If
If Not IsEmpty(oUser.facsimileTelephoneNumber) Then
	OutPutFileHtml.WriteLine "<FONT face=Arial size=2>Fax	 " & oUser.facsimileTelephoneNumber & "</FONT><BR>"
End If
OutPutFileHtml.WriteLine "<FONT face=Arial size=2><A href=""mailto:"
OutPutFileHtml.WriteLine oUser.mail
OutPutFileHtml.WriteLine """>mailto:" & oUser.mail & "</A></FONT><BR>"
'
'
'Put your WEB Site instead of www.xxxxxxxxx.com (twice)
'
'
OutPutFileHtml.WriteLine "			</SPAN><A href=""http://www.xxxxxxxxx.com""><SPAN"
OutPutFileHtml.WriteLine "			lang=fr><U><FONT face=Arial color=#0000ff"
OutPutFileHtml.WriteLine "			size=2>http://www.xxxxxxxxx.com</FONT></U></SPAN></A></P></TD>"
OutPutFileHtml.WriteLine "			</TR></TBODY></TABLE></DIV></BODY></HTML>"
OutPutFileHtml.Close
WScript.Quit(0)

Télécharger le projet

Codes Sources

..
VBFrance

A voir également

Signature standardisée dans outlook via paramètres active directory de l'utilisateur
Signature outlook automatique active directory ✓ - Forum VB.NET
Java signature - Forum Java
Activer macro outlook - Forum Visual Basic
Comment activer les macro dans outlook - Forum Visual Basic
Les macros sur Outlook ne fonctionnent plus et ne sont plus accessibles ! - Forum VBA Office (Excel, Word ...)

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Signature standardisée dans outlook via paramètres active directory de l'utilisateur

Description

Source / Exemple :

Codes Sources

A voir également

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Du même auteur (drassef14)

Comment renommer un ou pusieurs nom de groupes active directory

Recherche des informations utilisateurs / groupes / computers dans active directory

Source / Exemple :

A voir également

Vous n'êtes pas encore membre ? inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Du même auteur (drassef14)

Comment renommer un ou pusieurs nom de groupes active directory

Recherche des informations utilisateurs / groupes / computers dans active directory

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !