[WIN2K3r2]Outlook VBS signature script problemen op TS

[Ijsklont]

Beste,

Ik ben bezig met een script om ervoor te zorgen dat bij gebruikers binnen onze organisatie een bepaalde handtekening als standaard bij nieuwe en beantwoorde emails word gebruikt in Outlook 2007.

Nu heb ik dit werkend bij de gewone werkstations, echter bij gebruikers die inloggen op onze terminal servers (Windows 2003 r2) blijf ik steeds de melding krijgen 'Please shut down Outlook before running this script'

Ik heb me hier inmiddels ook op google zitten zoeken maar tot nu toe ben ik maar ergens 1 topic tegen gekomen met het zelfde probleem, echter die dateert uit januari 2009 maar totaal geen reacties daar verder.

Kan iemand mij hiermee helpen?

Visual Basic:

'====================
'
' VBScript: <defaultSignature.vbs>

' This script will think that the correct signatures are already in the folder " %appdata%\Microsoft\Handtekeningen "
'==================== 

'Option Explicit
On Error Resume Next

Call SetDefaultSignature("handtekening2011","")

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
            'On Error Resume Next
            objreg.SetBinaryValue HKEY_CURRENT_USER, _
              strsubkeypath, "New Signature", myArray
            objreg.SetBinaryValue HKEY_CURRENT_USER, _
              strsubkeypath, "Reply-Forward Signature", myArray
        Next
    Else
        strMsg = "Please shut down Outlook before " & _
                 "running this script."
        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

[Voor 0% gewijzigd door alt-92 op 23-06-2011 17:35]

[alt-92]

Ijsklont schreef op donderdag 23 juni 2011 @ 16:44:

Nu heb ik dit werkend bij de gewone werkstations, echter bij gebruikers die inloggen op onze terminal servers (Windows 2003 r2) blijf ik steeds de melding krijgen 'Please shut down Outlook before running this script'

Well duh Op een werkstation zal je doorgaans maar één lopend Outlook proces aantreffen.
Jij zoekt je hele TS af:

Visual Basic:

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

Zijn Group Policy Preferences hier niet makkelijker voor? Werken ook op 2003 met de juiste client bits..

[Voor 36% gewijzigd door alt-92 op 23-06-2011 17:37]

[Ijsklont]

alt-92 schreef op donderdag 23 juni 2011 @ 17:37:
[...]


Well duh Op een werkstation zal je doorgaans maar één lopend Outlook proces aantreffen.
Jij zoekt je hele TS af:

Zijn Group Policy Preferences hier niet makkelijker voor? Werken ook op 2003 met de juiste client bits..

Dat wist ik eigenlijk ook wel, alleen wat ik hoop te vinden is een aanpassing in deze code zodat dit wel werkt op een TS sessie.

Wat betreft Group Policy Preferences, ik heb hiervoor zitten zoeken maar kan niet vinden waar ik dit dan zou kunnen doen....... of ik heb gewoon een nieuwe bril nodig

Edit: De settings voor Outlook 2007 heb ik wel inmiddels... maar de optie voor handtekening krijg ik niet gevonden

Overigens werken wij hier met Exchange 2003, Office 2007 en Windows XP/7.

[Voor 7% gewijzigd door Ijsklont op 24-06-2011 09:24]

[alt-92]

Preferences kun je zelf doen wat je wil - grote voordeel is dat je met Item-level targeting voor zowel XP als 7 de verschillende lokaties op de disk qua folders van dezelfde bestanden kan voorzien.

[Ijsklont]

Ik heb de optie gevonden om handtekening te kunnen blokkeren en niet toegangbaar te maken voor de gebruiker maar ik kan niet de optie vinden om de standaard handtekening te kunnen instellen.

Ik heb overigens wel in de login.bat geregeld dat deze bij aanmelden alle inhoud van de handtekening map weggooit en de handtekening(en) van de gebruiker (die op de server bevinden) weer kopieert.

[Krypt]

Je kunt in je check gewoon de username meenemen; de onderstaande code vangt alleen meerdere sessies van 1 user op een server niet af:

Dit is de function die ik gebruik.

code:

Function CheckProcessRunning(strProcess)
 '
 With GetObject("winmgmts:root\cimv2")
  For Each objProcess in .ExecQuery("SELECT commandline FROM Win32_Process" & " WHERE Name ='" & strProcess & "'",,48)
   With .ExecMethod("Win32_Process.Handle='" & objProcess.Handle & "'", "GetOwner")
    If Lcase(.User) = Lcase(CreateObject("WScript.Shell").ExpandEnvironmentStrings("%USERNAME%")) Then CheckProcessRunning=True
   End With
  Next
 End With
 '
End Function

[Ijsklont]

Krypt schreef op vrijdag 24 juni 2011 @ 11:45:
Je kunt in je check gewoon de username meenemen; de onderstaande code vangt alleen meerdere sessies van 1 user op een server niet af:

Dit is de function die ik gebruik.

code:

Function CheckProcessRunning(strProcess)
 '
 With GetObject("winmgmts:root\cimv2")
  For Each objProcess in .ExecQuery("SELECT commandline FROM Win32_Process" & " WHERE Name ='" & strProcess & "'",,48)
   With .ExecMethod("Win32_Process.Handle='" & objProcess.Handle & "'", "GetOwner")
    If Lcase(.User) = Lcase(CreateObject("WScript.Shell").ExpandEnvironmentStrings("%USERNAME%")) Then CheckProcessRunning=True
   End With
  Next
 End With
 '
End Function

Bedankt, ik ga het na de pauze gelijk even testen

Edit: Nice het werkt , hartelijk bedankt