[Office 2003]Default font via Group Policy

[misterm90]

hallo,
we moeten een nieuwe huisstijl definieeren met nieuwe default font.
we hebben een server 2003 omgeving en office 2003 op alle clients ( 60+)
Dus ik dacht dat dit heel makkelijk kon met Group Policy. even een .adm van microsoft gedownload.
maar nu kan je daar geen default font mee instellen.
hoe stel je dat in voor al die gebruikers dat ze 1 specifieke Font gebruiken en ook de stijl van de handtekeningen.
ik had al wat gevonden over Outlook 2007. maar dat gaat via registerfiles.. en dat is precies wat we niet willen
Alvast bedankt.

Merlijn

[BtM909]

Kan je wel een normal.dot pushen?

Overigens, gaat je vraag nou over Word en / of Outlook 2003?

Voor Outlook, moet je wel degelijk in de adm een default font kunnen specificeren: http://www.experts-exchan...MS_Office/Q_22871521.html

[ Voor 79% gewijzigd door BtM909 op 15-12-2008 12:44 ]

[Question Mark]

mistermerlijn schreef op maandag 15 december 2008 @ 12:09:
ik had al wat gevonden over Outlook 2007. maar dat gaat via registerfiles.. en dat is precies wat we niet willen

Registry settings kunnen via een custom gemaakte ADM (die je importeerd in je GPO) gedeployed worden. Misschien ook nog een optie.

[misterm90]

BtM909 schreef op maandag 15 december 2008 @ 12:39:
Kan je wel een normal.dot pushen?

Overigens, gaat je vraag nou over Word en / of Outlook 2003?

Voor Outlook, moet je wel degelijk in de adm een default font kunnen specificeren: http://www.experts-exchan...MS_Office/Q_22871521.html

mijn vraag gaat over Outlook himself.

die site die je opgeeft moet je voor betalen/ registreren met creditcard. nu heb ik dus geen creditcard en het bedrijf gaat dit ook niet betalen

overigens ga ik nu even kijken hoe je de normal.dot kan veranderen.

[Question Mark]

mistermerlijn schreef op maandag 15 december 2008 @ 13:08:
[...]
die site die je opgeeft moet je voor betalen/ registreren met creditcard. nu heb ik dus geen creditcard en het bedrijf gaat dit ook niet betalen .

Scroll even helemaal naar beneden

Overigens zou ik persoonlijk niet de custom.adm aanpassen, maar gewoon nieuwe sjablonen gaan deployen.

[ Voor 16% gewijzigd door Question Mark op 15-12-2008 13:13 ]

[BtM909]

Question Mark schreef op maandag 15 december 2008 @ 13:10:
[...]
Scroll even helemaal naar beneden

indeed

Overigens is dit het belangrijkste woord uit de gegeven oplossing: Outlk11.adm

[misterm90]

BtM909 schreef op maandag 15 december 2008 @ 13:12:
[...]

indeed

Overigens is dit het belangrijkste woord uit de gegeven oplossing: Outlk11.adm

Je bedoelt die 7 dagen free trial ?
ik was bezig met registreren maar dan moet je alsnog een creditcardnummer opgeven
en die Outlk11.adm heb ik al toegevoegd als policy. die kan je gewoon van de microsoft downloaden als een kit. hierbij kun je van alles wijzigen,behalve de default font etcetera..


hierbij de screens van de outlk11.adm

[ Voor 42% gewijzigd door misterm90 op 15-12-2008 14:17 ]

[misterm90]

ik heb de perfecte vbs gevonden.
deze maakt gebruik van Active Directory en implementeert dit in Outlook als default handtekening
als deze handtekening erin is gegooid heb ik een registerfiletje bij gedaan voor Lettertypes. ( sorry....wel register dus..:=) )

'====================

'

' VBScript: <Signatures.vbs>

' AUTHOR: Peter Aarts

' Contact Info: [e-mail]

' Version 2.04

' Date: January 20, 2006

'

'====================

'Option Explicit

On Error Resume Next

Dim qQuery, objSysInfo, objuser

Dim FullName, EMail, Title, PhoneNumber, MobileNumber, FaxNumber, OfficeLocation, Department

Dim web_address, FolderLocation, HTMFileString, StreetAddress, Town, State, Company

Dim ZipCode, PostOfficeBox, UserDataPath

' Read LDAP(Active Directory) information to asigns the user's info to variables.

'====================

Set objSysInfo = CreateObject("ADSystemInfo")

objSysInfo.RefreshSchemaCache

qQuery = "LDAP://" & objSysInfo.Username

Set objuser = GetObject(qQuery)

FullName = objuser.displayname

EMail = objuser.mail

Company = objuser.Company

Title = objuser.title

PhoneNumber = objuser.TelephoneNumber

FaxNumber = objuser.FaxNumber

OfficeLocation = objuser.physicalDeliveryOfficeName

StreetAddress = objuser.streetaddress

PostofficeBox = objuser.postofficebox

Department = objUser.Department

ZipCode = objuser.postalcode

Town = objuser.l

MobileNumber = objuser.TelephoneMobile

web_address = "http://www.bedrijf.com"

' This section creates the signature files names and locations.

'====================

' Corrects Outlook signature folder location. Just to make sure that

' Outlook is using the purposed folder defined with variable : FolderLocation

' Example is based on Dutch version.

' Changing this in a production enviremont might create extra work

' all employees are missing their old signatures

'====================

Dim objShell, RegKey, RegKeyParm

Set objShell = CreateObject("WScript.Shell")

RegKey = "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\General"

RegKey = RegKey & "\Signatures"

objShell.RegWrite RegKey , "Handtekeningen"

UserDataPath = ObjShell.ExpandEnvironmentStrings("%appdata%")

FolderLocation = UserDataPath &"\Microsoft\Handtekeningen\"

HTMFileString = FolderLocation & "bedrijfcom-Handtekening.htm"

' This section disables the change of the signature by the user.

'====================

' This section checks if the signature directory exits and if not creates one.

'====================

Dim objFS1

Set objFS1 = CreateObject("Scripting.FileSystemObject")

If (objFS1.FolderExists(FolderLocation)) Then

Else

Call objFS1.CreateFolder(FolderLocation)

End if

' The next section builds the signature file

'====================

Dim objFSO

Dim objFile,afile

Dim aQuote

aQuote = chr(34)

' This section builds the HTML file version

'====================

Set objFSO = CreateObject("Scripting.FileSystemObject")

' This section deletes to other signatures.

' These signatures are automaticly created by Outlook 2003.

'====================

Set AFile = objFSO.GetFile(Folderlocation&"bedrijfcom-Handtekening.rtf")

aFile.Delete

Set AFile = objFSO.GetFile(Folderlocation&"bedrijfcom-Handtekening.txt")

aFile.Delete

Set objFile = objFSO.CreateTextFile(HTMFileString,True)

objFile.Close

Set objFile = objFSO.OpenTextFile(HTMFileString, 2)

objfile.write "<!DOCTYPE HTML PUBLIC " & aQuote & "-//W3C//DTD HTML 4.0 Transitional//EN" & aQuote & ">" & vbCrLf

objfile.write "<HTML><HEAD><TITLE>bedrijf Signature</TITLE>" & vbCrLf

objfile.write "<META http-equiv=Content-Type content=" & aQuote & "text/html; charset=windows-1252" & aQuote & ">" & vbCrLf

objfile.write "<META content=" & aQuote & "MSHTML 6.00.3790.186" & aQuote & " name=GENERATOR></HEAD>" & vbCrLf

objfile.write "<body link=#000080 vlink=#000080 alink=#000080 bgcolor=#FFFFFF>" & vbCrLf

objfile.write "<FONT size=2 face=" & aQuote & "Tahoma" & aQuote & ">Met vriendelijke groet,<br>"& vbCrLf

objfile.write FullName & "<BR>" & vbCrLf

objfile.write title & "</font><br><br>" & vbCrLf

objfile.write "<img border=" & aQuote & "0" & aQuote & "src=" & aQuote & "file:///N:/Handtekeningen/bedrijflogomaill.gif"& aQuote & width="146" height="62"/><><br><br>" & vbCrLf

objfile.write "<FONT size=1 face=" & aQuote & "Tahoma" & aQuote & ">bedrijf B.V., <BR>" & vbCrLf

objfile.write "<BR>" & vbCrLf

objfile.write "Tel." & vbCrLf

objfile.write "</FONT></BODY></HTML>" & vbCrLf

objfile.write ""

objFile.Close

' ===========================

' This section readsout the current Outlook profile and then sets the name of the default Signature

' ===========================

' Use this version to set all accounts

' in the default mail profile

' to use a previously created signature

Call SetDefaultSignature("bedrijfcom-Handtekening","")

' Use this version (and comment the other) to

' modify a named profile.

'Call SetDefaultSignature _

' ("Signature Name", "Profile Name")

Sub SetDefaultSignature(strSigName, strProfile)

Const HKEY_CURRENT_USER = &H80000001

strComputer = "."

If Not IsOutlookRunning Then

Set objreg = GetObject("winmgmts:" & _

"{impersonationLevel=impersonate}!\\" & _

strComputer & "\root\default:StdRegProv")

strKeyPath = "Software\Microsoft\Windows NT\" & _

"CurrentVersion\Windows " & _

"Messaging Subsystem\Profiles\"

' get default profile name if none specified

If strProfile = "" Then

objreg.GetStringValue HKEY_CURRENT_USER, _

strKeyPath, "DefaultProfile", strProfile

End If

' build array from signature name

myArray = StringToByteArray(strSigName, True)

strKeyPath = strKeyPath & strProfile & _

"\9375CFF0413111d3B88A00104B2A6676"

objreg.EnumKey HKEY_CURRENT_USER, strKeyPath, _

arrProfileKeys

For Each subkey In arrProfileKeys

strsubkeypath = strKeyPath & "\" & subkey

objreg.SetBinaryValue HKEY_CURRENT_USER, _

strsubkeypath, "New Signature", myArray

objreg.SetBinaryValue HKEY_CURRENT_USER, _

strsubkeypath, "Reply-Forward Signature", myArray

Next

Else

strMsg = "Graag Outlook sluiten " & _

"voordat dit script word gedraait."

MsgBox strMsg, vbExclamation, "SetDefaultSignature"

End If

End Sub

Function IsOutlookRunning()

strComputer = "."

strQuery = "Select * from Win32_Process " & _

"Where Name = 'Outlook.exe'"

Set objWMIService = GetObject("winmgmts:" _

& "{impersonationLevel=impersonate}!\\" _

& strComputer & "\root\cimv2")

Set colProcesses = objWMIService.ExecQuery(strQuery)

For Each objProcess In colProcesses

If UCase(objProcess.Name) = "OUTLOOK.EXE" Then

IsOutlookRunning = True

Else

IsOutlookRunning = False

End If

Next

End Function

Public Function StringToByteArray _

(Data, NeedNullTerminator)

Dim strAll

strAll = StringToHex4(Data)

If NeedNullTerminator Then

strAll = strAll & "0000"

End If

intLen = Len(strAll) \ 2

ReDim arr(intLen - 1)

For i = 1 To Len(strAll) \ 2

arr(i - 1) = CByte _

("&H" & Mid(strAll, (2 * i) - 1, 2))

Next

StringToByteArray = arr

End Function

Public Function StringToHex4(Data)

' Input: normal text

' Output: four-character string for each character,

' e.g. "3204" for lower-case Russian B,

' "6500" for ASCII e

' Output: correct characters

' needs to reverse order of bytes from 0432

Dim strAll

For i = 1 To Len(Data)

' get the four-character hex for each character

strChar = Mid(Data, i, 1)

strTemp = Right("00" & Hex(AscW(strChar)), 4)

strAll = strAll & Right(strTemp, 2) & Left(strTemp, 2)

Next

StringToHex4 = strAll

End Function

' Tenslotte nog even de Lettertype Tahoma met Puntje 10 forceren

Set oShell = CreateObject("Wscript.Shell")

sRegFile = "\\netwerk-data\NETLOGON\lettertypen.reg"

oShell.Run "regedit.exe /s " & Chr(34) & sRegFile & Chr(34), 0, True

dit is echt een super script en werkt snel en effectief. ik heb de regel dat je het niet meer kon bewerken weggehaald zodat de gebruikers nog wel konden bewerken voor hun functie er in te zetten

//edit . hoe kan je deze code eigenlijk zo neerzetten dat je de codeveld moet scrollen ipv deze hele pagina ?

[Verwijderd]

code zet je tussen [code][/code]-tags, maar daar worden geen verticale scrollbars op toegepast vziw.