Sujet Précédent Sujet Suivant

SCRIPT VBS OUTLOOK SIGNATURE STANDARDISE

LUCCOR Messages postés 1 Date d'inscription samedi 26 avril 2008 Statut Membre Dernière intervention 5 décembre 2008 - 3 déc. 2008 à 11:49
lecoquierre Messages postés 5 Date d'inscription dimanche 19 février 2006 Statut Membre Dernière intervention 8 juillet 2010 - 16 janv. 2009 à 16:37
Bonjour,

Je recherche un script me permettant de standardisé les signatures outlook pour tous mes utilsateurs.

Lors de l'execution de celui trouver sur le site j'ai une erreur 8007202B

Ligne 33
Caract 2
Erreur : une référence a été renvoyée par le serveur
Code : 8007202B
Source : (Null)

Voici le script :

'---------------------------------------------------------------------------------------------------------
'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=LGF,dc=gaia,dc=lgf, dc=local,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 ""
     OutPutFileHtml.WriteLine "
"
     OutPutFileHtml.WriteLine "\"
     OutPutFileHtml.WriteLine \"  \"
     OutPutFileHtml.WriteLine \"  ----
\"
     OutPutFileHtml.WriteLine \"    Salutations / Best regards
"
     OutPutFileHtml.WriteLine "
"
     OutPutFileHtml.WriteLine "" & oUser.description & "
"
     OutPutFileHtml.WriteLine "--
"
     OutPutFileHtml.WriteLine "" & oUser.title & "
"
     OutPutFileHtml.WriteLine "" & oUser.department & "
"
     OutPutFileHtml.WriteLine "" & oUser.postOfficeBox & ", " & oUser.streetAddress & ", " & oUser.postalCode & " " & oUser.l & "
"
     If Not IsEmpty(oUser.telephoneNumber) Then
      OutPutFileHtml.WriteLine "Phone " & oUser.telephoneNumber & "
"
     End If
     If Not IsEmpty(oUser.mobile) Then
      OutPutFileHtml.WriteLine "Mobile " & oUser.mobile & "
"
     End If
     If Not IsEmpty(oUser.facsimileTelephoneNumber) Then
      OutPutFileHtml.WriteLine "Fax   " & oUser.facsimileTelephoneNumber & "
"
     End If
     OutPutFileHtml.WriteLine "[ldap://RootDSE 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.gestionfonciere.fr
'
'
OutPutFileTxt.WriteLine "http://www.gestionfonciere.fr"
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 ""
OutPutFileHtml.WriteLine "
"
OutPutFileHtml.WriteLine "\"
OutPutFileHtml.WriteLine \" \"
OutPutFileHtml.WriteLine \" ----
\"
OutPutFileHtml.WriteLine \"  "
OutPutFileHtml.WriteLine "
"
OutPutFileHtml.WriteLine "Salutations / Best regards
"
OutPutFileHtml.WriteLine "
"
OutPutFileHtml.WriteLine "" & oUser.description & "
"
OutPutFileHtml.WriteLine "--
"
OutPutFileHtml.WriteLine "" & oUser.company & "
"
OutPutFileHtml.WriteLine "" & oUser.title & "
"
OutPutFileHtml.WriteLine "" & oUser.department & "
"
OutPutFileHtml.WriteLine "" & oUser.postOfficeBox & ", " & oUser.streetAddress & ", " & oUser.postalCode & " " & oUser.l & "
"
If Not IsEmpty(oUser.telephoneNumber) Then
 OutPutFileHtml.WriteLine "Phone " & oUser.telephoneNumber & "
"
End If
If Not IsEmpty(oUser.mobile) Then
 OutPutFileHtml.WriteLine "Mobile " & oUser.mobile & "
"
End If
If Not IsEmpty(oUser.facsimileTelephoneNumber) Then
 OutPutFileHtml.WriteLine "Fax  " & oUser.facsimileTelephoneNumber & "
"
End If
OutPutFileHtml.WriteLine "mailto:" & oUser.mail & "
"
'
'
'Put your WEB Site instead of www.gestionfonciere.fr (twice)
'
'
OutPutFileHtml.WriteLine "   http://www.gestionfonciere.fr"">"
OutPutFileHtml.WriteLine "   lang=fr>http://www.gestionfonciere.fr, \"
OutPutFileHtml.WriteLine "   

</HTML>"
OutPutFileHtml.Close
WScript.Quit(0)

Lucalefabcor

1 réponse

Réponse 1 / 1
lecoquierre Messages postés 5 Date d'inscription dimanche 19 février 2006 Statut Membre Dernière intervention 8 juillet 2010
16 janv. 2009 à 16:37
salut
as tu trouvé une solution

j'ai un script qui pourrait t'aider sinon
0

Discussions similaires

signature outlook
cs_eldim -
eldim -

1 réponse
Signature Outlook dans macro Excel
1Alexiiis -
cs_Le Pivert -

17 réponses
Activer macros outlook
biggir -
ajarnaud -

4 réponses
Comment fonctionne la fonction FormulaR1C1
cs_razmokets -
wape -

2 réponses
fonction modulo en VBA
krisprolss -
Benouille -

2 réponses
Rejoignez-nous