More Outlook Resource Sites

Microsoft Developer Network (MSDN)

FAQs and other general resources

share code 18-Oct-2017 11:09

Looking for help with Outlook programming projects — VSTO, add-ins, VBA, custom Outlook forms, etc.? You′ve come to the right place!

NEW! >> Subscribe to this site via RSS. For more RSS options, see the complete list of feeds on our main news page.

Code level: advanced    Code area: Code Essentials Printer Friendly Version
Title: WMI script to set Outlook Address Book order
Description: The WMI scripting engine's ability to iterate registry subkeys makes it very useful to Outlook profile work. This sample, my first WMI script, sets the Outlook Address Book order to File As (Last, First) or First Last, depending on your choices.
Date: 10-Mar-2005  07:52
Code level: advanced
Code area: Code Essentials
Posted by: Sue Mosher
This message is displayed as VB.NET
 ' Use this version to set the default profile
Call SetOABLastFirst(True, "") 

' Use this version (and comment the other) to 
' set a named profile.
' Call SetOABLastFirst(True, "profilename")

Sub SetOABLastFirst(blnLastFirst, strProfile)
    ' If blnLastFirst = True, set OAB order to File As (Last, First)
    ' If blnLastFirst = False, set OAB order to First Last
    ' strProfile can be a named profile or blank.
    '   If blank, set the order on the default profile.
    On Error Resume Next
    Const HKEY_CURRENT_USER = &H80000001
    strComputer = "."
    blnFoundKey = False
    
    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 string for service DLL file
        strServDLL = StringToHex4("contab.dll")
        ' get profile name
        If strProfile = "" Then
            objreg.GetStringValue HKEY_CURRENT_USER, strKeyPath, _
                                "DefaultProfile", strProfile
        End If
        If strProfile <> "" Then
            strKeyPath = strKeyPath & strProfile
            objreg.EnumKey HKEY_CURRENT_USER, strKeyPath, arrProfileKeys
            For Each subkey In arrProfileKeys
               strSubkeyPath = strKeyPath & "\" & subkey
                ' 001f300a value contains name of the service DLL file
                objreg.GetBinaryValue HKEY_CURRENT_USER, strSubkeyPath, _
                                      "001f300a", arrKeyValue
                If Not IsNull(arrKeyValue) Then
                    For i = 0 To UBound(arrKeyValue)
                        ' build string from hex values
                        strhexkeyvalue = strhexkeyvalue & HexByte(arrKeyValue(i))
                        ' compare with service neame
                    Next
'                    If InStr(strhexkeyvalue, strServDLL) = 1 Then
                     If InStr(strhexkeyvalue, strServDLL) >0  Then    ' code updated 7 Apr 2006 [SM]
                        blnFoundKey = True
                        'we have the right key, so change the value
                        If blnLastFirst Then
                            arrBinary = Array(1, 0)
                        Else
                            arrBinary = Array(0, 0)
                        End If
                        objreg.SetBinaryValue HKEY_CURRENT_USER, strSubkeyPath, _
                            "000b6602", arrBinary
                        
                        Exit For
                    End If
                End If
            Next
            If blnFoundKey = False Then
                strMsg = "Could not find Outlook Address Book in the " & _
                         strProfile & " mail profile."
                MsgBox strMsg, vbExclamation, "SetOABLastFirst"
            End If
        Else
            strMsg = "Please run Outlook once before running this script. "
            MsgBox strMsg, vbExclamation, "SetOABLastFirst"
        End If
    Else
        strMsg = "Please shut down Outlook before running this script."
        MsgBox strMsg, vbExclamation, "SetOABLastFirst"
    End If
End Sub

Function IsOutlookRunning()
    strComputer = "."
    Set objWMIService = GetObject("winmgmts:" _
        & "{impersonationLevel=impersonate}!\\" _
        & strComputer & "\root\cimv2")
    Set colProcesses = objWMIService.ExecQuery _
      ("Select * from Win32_Process Where Name = 'Outlook.exe'")
    For Each objProcess In colProcesses
        If UCase(objProcess.Name) = "OUTLOOK.EXE" Then
            IsOutlookRunning = True
        Else
            IsOutlookRunning = False
        End If
    Next
End Function

Function HexByte(b)
      HexByte = Right("0" & Hex(b), 2)
End Function

Public Function StringToHex4(Data)     ' Input: normal text
    ' Output: four-character strings 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 strChar 
    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
All 30comments
Page [ 1 2 3 Next >>  
  10-Mar-2005  15:55   
The code is VBScript. Copy into Notepad, save with a .vbs file name, and run it to execute the script.
  30-Mar-2005  10:26   
For a good introduction to WMI scripting, see http://msdn.microsoft.com/library/en-us/dnclinic/html/scripting06112002.asp

For another WMI script to set the new and reply/forward signatures for all email accounts in a profile, see http://www.outlookcode.com/codedetail.aspx?id=821
 
  04-Apr-2005  07:11   
I tried to use this this script with outlook 2003 and no luck....
  04-Apr-2005  07:14   
Works fine here. DId you check to see whether the registry value had changed after you ran the script? Errors or other symptoms?
  18-May-2005  04:14   
Does this also work for users with limited rights?
  18-May-2005  08:14   
It should work, since the only portion of the registry you're modifying is that for the mail profile in HKCU, which users must have the rights to modify. (If they didn't, a whole lot of Outlook features wouldn't work at all.)
  24-Jun-2005  05:09   
Thanks, great.
But: not familiar to wmi, sorry. Any known limitations? OS-restrictions for using that?
No details needed (but would make me even happier), but may be there's a big an definitive "NO GO" somewhere?
Thx in advance.
  01-Jul-2005  11:35   
Benthal, I'm still a WMI novice myself, but these look like good resources:

WMI Overview
http://www.microsoft.com/technet/scriptcenter/guide/sas_wmi_dieu.mspx

WMI Scripting Primer
http://msdn.microsoft.com/library/en-us/dnclinic/html/scripting06112002.asp
 
  07-Sep-2005  08:24   
Does this script work for other Outlook languages different from English?
  07-Sep-2005  10:02   
Since the registry values involved are not localized, I would expect it to work. However, the only way to know for certain is to try it: Let us know what you find out.

You probably would, of course, want to change the MsgBox text.
Page [ 1 2 3 Next >>