4
Nur wenn Office installiert Autosignatur ausführen
Hallo,
ich versuche habe in VBS ein Programm, welches mir eine Autosignatur für Outlook erstellt. Das ganze funktioniert gut, allerdings würde ich dieses gerne in die Gruppenrichtlinien aufnehmen. Da es in unserem Unternehmen jedoch einige PCs gibt, die kein Office installiert haben, liefert mir das Skript einen Fehler.
Das ganze möchte ich gerne für 32 und 64 Bit Clients umgehen.
Nur für 32 Bit habe ich etwas im Internet gefunden:
da die Einträge unter 64Bit in der Registry noch unter Wow6432Node stehen, funktioniert das so nicht.
was muss ich einfügen, dass es auch unter 64-Bit Systemen erkannt wird?
ich habe mich schon mit OR daran gewagt aber so ganz funktioniert das nicht wie ich das will.
Es kann auch gerne ein komplett anderer Code sein der funktioniert.
Danke.
ich versuche habe in VBS ein Programm, welches mir eine Autosignatur für Outlook erstellt. Das ganze funktioniert gut, allerdings würde ich dieses gerne in die Gruppenrichtlinien aufnehmen. Da es in unserem Unternehmen jedoch einige PCs gibt, die kein Office installiert haben, liefert mir das Skript einen Fehler.
Das ganze möchte ich gerne für 32 und 64 Bit Clients umgehen.
Nur für 32 Bit habe ich etwas im Internet gefunden:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
dim bExists
ssig="Unable to open registry key"
set wshShell= Wscript.CreateObject("WScript.Shell")
strKey = "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Office"
on error resume next
present = WshShell.RegRead(strKey)
if err.number<>0 then
if right(strKey,1)="\" then
if instr(1,err.description,ssig,1)<>0 then
bExists=true
else
bExists=false
end if
else
bExists=false
end if
err.clear
else
bExists=true
end if
on error goto 0
if bExists=vbFalse then
else
----SIGNATUR----
end ifda die Einträge unter 64Bit in der Registry noch unter Wow6432Node stehen, funktioniert das so nicht.
was muss ich einfügen, dass es auch unter 64-Bit Systemen erkannt wird?
ich habe mich schon mit OR daran gewagt aber so ganz funktioniert das nicht wie ich das will.
Es kann auch gerne ein komplett anderer Code sein der funktioniert.
Danke.
Auf Facebook teilen
Auf X (Twitter) teilen
Auf Reddit teilen
Auf Linkedin teilenBitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 211007
Url: https://administrator.de/forum/nur-wenn-office-installiert-autosignatur-ausfuehren-211007.html
Ausgedruckt am: 08.04.2025 um 11:04 Uhr
4 Kommentare
Neuester Kommentar
Hallo fluluk!
Versuchs mal damit:
Gruß Dieter
Versuchs mal damit:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Option Explicit
'Backslash am Ende beachten
Const sReg32Key = "HKLM\Software\Microsoft\Office\"
Const sReg64Key = "HKLM\Software\Wow6432Node\Microsoft\Office\"
Dim sOffice32, sOffice64
On Error Resume Next
With CreateObject("WScript.Shell")
sOffice32 = .RegRead(sReg32Key)
sOffice64 = .RegRead(sReg64Key)
If IsEmpty(sOffice32) And IsEmpty(sOffice64) Then
MsgBox "Office nicht installiert"
Else
MsgBox "Office installiert"
End If
End With
On error Goto 0Gruß Dieter
ja, so wird Office schonmal erkannt, wenn ich nun allerdings die MsgBox durch mein Skript ersetze, wird es nicht ausgeführt
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
Option Explicit
'Backslash am Ende beachten
Const sReg32Key = "HKLM\Software\Microsoft\Office\"
Const sReg64Key = "HKLM\Software\Wow6432Node\Microsoft\Office\"
Dim sOffice32, sOffice64
On Error Resume Next
With CreateObject("WScript.Shell")
sOffice32 = .RegRead(sReg32Key)
sOffice64 = .RegRead(sReg64Key)
If IsEmpty(sOffice32) And IsEmpty(sOffice64) Then
MsgBox "Office nicht installiert"
Else
On Error Resume Next
Set objSysInfo = CreateObject("ADSystemInfo")
Set WshShell = CreateObject("WScript.Shell")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strName = objUser.FirstName & " " & objUser.LastName
strTitle = objUser.Title
strDepa = objUser.Department
strCred = objUser.info
strCompany = objUser.Company
strStreet = objUser.StreetAddress
strLocation = objUser.l
strPostCode = objUser.PostalCode
strPhone = objUser.TelephoneNumber
strMobile = objUser.Mobile
strFax = objUser.FacsimileTelephoneNumber
strEmail = "mailto:" & objUser.mail
strEmail2 = objUser.mail
strHP = objUser.HomePage
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
.
.
.
Set objSelection = objDoc.Range()
objSignatureEntries.Add "complete Signature", objSelection
objSignatureObject.NewMessageSignature = "complete Signature"
objDoc.Saved = True
objWord.Quit
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
.
.
.
Set objSelection = objDoc.Range()
objSignatureEntries.Add "Reply Signature", objSelection
objSignatureObject.ReplyMessageSignature = "Reply Signature"
objDoc.Saved = True
objWord.Quit
End If
End With
On error Goto 0
Hallo fluluk!
Der Fehler liegt wohl in erster Linie daran, dass am Code-Anfang 'Option Explicit' steht und Du keine Variablen per Dim deklariert hast. Also entweder die erste Codezeile entfernen oder die Variablen deklarieren...
Ansonsten würde ich es eher so machen:
Gruß Dieter
Der Fehler liegt wohl in erster Linie daran, dass am Code-Anfang 'Option Explicit' steht und Du keine Variablen per Dim deklariert hast. Also entweder die erste Codezeile entfernen oder die Variablen deklarieren...
Ansonsten würde ich es eher so machen:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
Option Explicit
'Backslash am Ende beachten
Const sReg32Key = "HKLM\Software\Microsoft\Office\"
Const sReg64Key = "HKLM\Software\Wow6432Node\Microsoft\Office\"
Dim objShell, strOffice32, strOffice64
On Error Resume Next
Set objShell = CreateObject("WScript.Shell")
With objShell
strOffice32 = .RegRead(sReg32Key)
strOffice64 = .RegRead(sReg64Key)
End With
If IsEmpty(strOffice32) And IsEmpty(strOffice64) Then
MsgBox "Office nicht installiert": WScript.Quit 1
End If
Err.Clear
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strName = objUser.FirstName & " " & objUser.LastName
strTitle = objUser.Title
strDepa = objUser.Department
strCred = objUser.info
strCompany = objUser.Company
strStreet = objUser.StreetAddress
strLocation = objUser.l
strPostCode = objUser.PostalCode
strPhone = objUser.TelephoneNumber
strMobile = objUser.Mobile
strFax = objUser.FacsimileTelephoneNumber
strEmail = "mailto:" & objUser.mail
strEmail2 = objUser.mail
strHP = objUser.HomePage
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
.
.
.
Set objSelection = objDoc.Range()
objSignatureEntries.Add "complete Signature", objSelection
objSignatureObject.NewMessageSignature = "complete Signature"
objDoc.Saved = True
objWord.Quit
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add()
Set objSelection = objWord.Selection
Set objEmailOptions = objWord.EmailOptions
Set objSignatureObject = objEmailOptions.EmailSignature
Set objSignatureEntries = objSignatureObject.EmailSignatureEntries
.
.
.
Set objSelection = objDoc.Range()
objSignatureEntries.Add "Reply Signature", objSelection
objSignatureObject.ReplyMessageSignature = "Reply Signature"
objDoc.Saved = True
objWord.Quit
If Err.Number Then
MsgBox "Fehler beim Erstellen der Email-Signaturen ": WScript.Quit 1
End If
WScript.Quit 0Gruß Dieter
ach, vielen Dank, so funktionierts.
Gruß Lukas
Gruß Lukas
