Pages

Wednesday, June 8, 2016

set-default-outlook-address-book-script

Update June 2016.. 


I have a lot of requests for this script still. Unfortunately, the process that it described was designed for Outlook 2007 (and earlier). It basically had you grab the default profile registry key, then specify the correct hex value for the address book you wanted. Nothing that couldn't be done via simple .REG file import. 

In Outlook 2010 and beyond, Microsoft changed the way the address book is specified. The script would appear to work, but Outlook wouldn't actually pull from the correct value. In my testing, it broke Outlook and I'd need to reset my profile to resolve.. Sigh.

If you'd like to play around with it, I've been able to piece together that post ( with help of cached pages and people's reposting the content in other forums).

To configure the script you'd need to:
  1. Set your Outlook Address Book to the view you want to set on the remote workstation. (Tools - Address Book - Tools - Options - Set show this address list first).
  2. 2.Export the registry key for this Outlook profile.
    3. [HKEY_CURRENT_USER\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\(your default Outlook profile)\9207f3e0a3b11019908b08002b2a56c2]
  3. Open the .REG file and copy the HEX code for "01023d06". For example: 00,00,00,00,dc,a7,40,c8,c0,42,10,1a,b4,b9,08,00,2b,2f,e1,82,01
  4. Edit the Set-DefaultABView.VBS file (see attached) line to use your hex code. Make sure to leave in the double-quotes. Const DestABUsers = "00,00,00,00,dc,a7,40,c8,c0,42,10,1a,b4,b9,08,00,2b,2f,e1,82,01" 
'==========================================================================
'
' NAME: Set-DefaultABView.VBS
'  
' Author: Eric Woodford  scripts@ericwoodford.com
' DATE  : 1/28/2009
'
' COMMENT: Set's the default addressbook view in Outlook 2003 and 2007.
'==========================================================================

' this value pulled from registry dump of the registry key "01023d06"
' HKCU\Software\Microsoft\WIndows NT\CurrentVersion\Windows Messaging Subystem\Profiles\My Profile\9207...5C2\

Const DestABUsers = "00,00,00,00,dc,a7,40,c8,c0,42,10,1a,b4,b9,08,00,2b,2f,e1,82,01,00,00,00,00,01,00,00,2f,67,75,69,64,3d,36,34,39,39,36,38,30,31,35,41,36,42,34,43,34,33,39,31,39,39,43,38,45,37,35,46,42,44,37,36,31,33,00"

' ################################### Helper Functions ##################################

Function ArrayAdd (Array, Value)
' add elements to an array
'   Array - array 
'   Value - value to add to array
  Dim ArrayUpper
  If Ubound(Array) < 0 Then
    ReDim Preserve Array(0)
    ArrayUpper = 0
  Else
    ArrayUpper = Ubound(Array) + 1
    ReDim Preserve Array(ArrayUpper)
  End If
  Array(ArrayUpper) = Value
End Function

Function RegistryRead (pServer, pKeyType, pSubTree, pKeyPath, pKeyName, pKeyData, pKeyDataType)
' obtain value of a registry key
'   pKeyData     - data value for that key
'   pkeyDataType - data type for that data value for that key
'   pKeyName     - key name
'   pKeyPath     - path where the key exist
'   pKeyType     - type of key (0 - everytype, 1 - string, 2 - binary, 3 - dword, 
'                  4 - multi-string, 5 - expandable string, 
'                  6 - enumerate multi-keys/folders)
'   pServer      - server name (ex. fg206, if server name is "." then it will use the current system)
'   pSubTree     - registry subtree (0 - HKEY_CLASSES_ROOT, 1 - HKEY_CURRENT_USER, 2 - HKEY_LOCAL_MACHINE,
'                                    3 - HKEY_USERS, 5 - HKEY_CURRENT_CONFIG)

  Const HKEY_CLASSES_ROOT = &H80000000, _
        HKEY_CURRENT_USER = &H80000001, _
        HKEY_LOCAL_MACHINE = &H80000002, _
        HKEY_USERS = &H80000003, _
        HKEY_CURRENT_CONFIG = &H80000005

  Dim objReg
  Dim Result, Server, SubTree
  Result = 0
  Server = pServer
  Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & Server & "\root\default:StdRegProv")
  Select Case pSubTree
    Case 0
      Subtree = HKEY_CLASSES_ROOT
    Case 1
      Subtree = HKEY_CURRENT_USER
    Case 2
      Subtree = HKEY_LOCAL_MACHINE
    Case 3
      Subtree = HKEY_USERS
    Case 5
      Subtree = HKEY_CURRENT_CONFIG
  End Select
  ' define subtree

  Select Case pKeyType
    Case 0
      Result = objReg.EnumValues(SubTree, pKeyPath & "\" & pKeyName, pKeyData, pKeyDataType)
      ' Keydata returns a single dimension array of key names while KeyDataType returns a
      ' a single dimension array of key types
    Case 1
      Result = objReg.GetStringValue(SubTree, pKeyPath, pKeyName, pKeyData)
    Case 2
      Result = objReg.GetBinaryValue(SubTree, pKeyPath, pKeyName, pKeyData)
      ' Keydata returns a single dimension array 
    Case 3
      Result = objReg.GetDWordValue(SubTree, pKeyPath, pKeyName, pKeyData)
    Case 4
      Result = objReg.GetMultiStringValue(SubTree, pKeyPath, pKeyName, pKeyData)
      ' Keydata returns an Array
    Case 5
      Result = objReg.GetExpandableStringValue(SubTree, pKeyPath, pKeyName, pKeyData)
    Case 6
      Result = objReg.EnumKey(SubTree, pKeyPath & "\" & pKeyName, pKeyData)
      ' Keydata returns an object Array
  End Select
  ' obtain key name data depending on key type
  ' objReg.GetStringValue - read a key in string format
  ' objReg.GetBinaryValue - read a key in binary format
  '   process single dimensional array ex: For Cnt = Lbound(Array) to Ubound(Array)
  ' objReg.GetDWordValue - read a key in dword format
  ' objReg.MutliStringValue - read a key in multi-string format/array format
  '   process mutlistring/array ex.: For Each Value in Array
  ' objReg.ExpandableStringValue - read a key in expandable string format
  ' objReg.EnumKey - read a key in an array format 
  '   process array ex.: For Each Value in Array

  RegistryRead = (Result = 0)
  ' pass value out of function, Result should be zero if registry key exist
End Function
' RegistryRead

Function RegistryWrite (pServer, pKeyType, pSubTree, pKeyPath, pKeyName, pKeyData)
' writes a value to a registry key
'   pKeyData     - data value for that key
'   pKeyName     - key name
'   pKeyPath     - path where the key exist
'   pKeyType     - type of key (1 - string, 2 - binary, 3 - dword, 4 - multi-string)
'   pServer      - server name (ex. fg206, if server name is "." then it will use the current system)
'   pSubTree     - registry subtree (0 - HKEY_CLASSES_ROOT, 1 - HKEY_CURRENT_USER, 2 - HKEY_LOCAL_MACHINE,
'                                    3 - HKEY_USERS, 5 - HKEY_CURRENT_CONFIG)

  Const HKEY_CLASSES_ROOT = &H80000000, _
        HKEY_CURRENT_USER = &H80000001, _
        HKEY_LOCAL_MACHINE = &H80000002, _
        HKEY_USERS = &H80000003, _
        HKEY_CURRENT_CONFIG = &H80000005
  ' declare constants

  Dim objReg
  ' declare objects variables

  Dim Result, Server, SubTree
  ' declare variables


  Result = 0
  ' initialize variables

  Server = pServer
  ' define what server to obtain registry info (replace period with server name)

  Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & Server & "\root\default:StdRegProv")
  ' create registry object

  Select Case pSubTree
    Case 0
      Subtree = HKEY_CLASSES_ROOT
    Case 1
      Subtree = HKEY_CURRENT_USER
    Case 2
      Subtree = HKEY_LOCAL_MACHINE
    Case 3
      Subtree = HKEY_USERS
    Case 5
      Subtree = HKEY_CURRENT_CONFIG
  End Select
  ' define subtree

  Select Case pKeyType
    Case 1
      Result = objReg.SetStringValue(SubTree, pKeyPath, pKeyName, pKeyData)
    Case 2
      Result = objReg.SetBinaryValue(SubTree, pKeyPath, pKeyName, pKeyData)
      ' Keydata must be a single dimension array 
    Case 3
      Result = objReg.SetDWordValue(SubTree, pKeyPath, pKeyName, pKeyData)
    Case 4
      Result = objReg.SetMultiStringValue(SubTree, pKeyPath, pKeyName, pKeyData)
      ' Keydata must be an Array
  End Select
  ' set key name data depending on key type
  ' objReg.SetStringValue - write a key in string format
  ' objReg.SetBinaryValue - write a key in binary format (must be a single dimensional array)
  ' objReg.SetDWordValue - read a key in dword format
  ' objReg.SetMutliStringValue - set a key in multi-string format (must be a single dimensional array)

  RegistryWrite = (Result = 0)
  ' pass value out of function, Result should be zero if registry write processed correctly
End Function
' RegistryWrite


Dim NewAddrBook()
ReDim NewAddrBook(-1)
For Each BinValue In Split(DestABUsers,",")
 intv = CInt("&h"&binValue)
 ArrayAdd NewAddrBook, intv
Next


Const OutlookDefaultAddressKey = "9207f3e0a3b11019908b08002b2a56c2", _
      OutlookDefaultAddressSubKey = "01023d06", _
      OutlookLookupAddressSubKey = "11023d05", _
      OutlookProfileLocation = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem", _
      OutlookProfileLocationSubKey = "Profiles"
   

OK = RegistryRead (".",1,1,OutlookProfileLocation&"\"&OutlookProfileLocationSubKey,"DefaultProfile",DefaultOKProfile,"")
If OK Then
 KeyLocation = trim(OutlookProfileLocation & "\" & OutlookProfileLocationSubKey & "\" & DefaultOKProfile)
 Ok = RegistryWrite(".", 2, 1, KeyLocation & "\" & OutlookDefaultAddressKey, OutlookDefaultAddressSubKey, NewAddrBook) 
End If



' Create Log file in root drive of current workstation with date and time script ran. 
Const ForReading = 1, ForWriting = 2, ForAppending = 8 
Set objShell = CreateObject("WScript.Shell")
Set colEnvironment = objShell.Environment("PROCESS")
objPath = colEnvironment("username")
Dim strOutFileName: strOutFileName = "C:\"&objpath&".log"
Set fso = CreateObject ("scripting.filesystemobject")
If fso.FileExists(strOutFileName) Then  
 Set Outfile = fso.OpenTextFile(strOutFileName ,ForAppending)
Else
 Set Outfile = fso.OpenTextFile(strOutFileName ,ForWriting, true)
End If
Outfile.writeline Date() & " " & Time()
outfile.close

No comments:

Post a Comment

Subscribe to: Post Comments (Atom)