none
Централизованное изменение расположения файла автоархивации RRS feed

  • Вопрос

  • Добрый день.

    Коллеги подскажите пожалуйста как в Outlook можно централизованно изменять расположение файла автоархивации? 

    Необходимо что бы у всех пользователей, файл располагался не по стандартному пути, а в \\netshare\MailArchives$\%USERNAME%\Archive.pst

    Административными шаблонами, это не сделать. Скрипт то же не могу найти.

    Настроить архив на Exchange не предлагать т.к. там нужны лицензии и дисковое пространство и прочее, прочее прочее, чего оперативно получить мы пока не можем. 

    Спасибо!

    27 июня 2017 г. 12:08

Ответы

  • Есть решение. 

    Имеется скрипт который меняет путь к файлу автоархива (путь берет из переменной NewPath), но работает только до Office 2013. Предварительно надо сделать "батник" вида 

    @eho off
    \\Yourdomain\sysvol\Outlook-set-autoarchive-path.vbs -NewPath:"\\YourArchivePath\MailArchivesShares$\%USERNAME%\Archive.pst" -Silent

    '=========================================================================
    ' VBScript Source File
    '
    ' AUTHOR:  Adrian Yannuzzi 
    ' COMPANY: MakeIT Consulting (www.makeit.com.ar)
    ' DATE:    22/09/2011
    ' COMMENT: This script is for changing the default Outlook Autoarchive
    '           PST location.
    '           Default Locations:
    '               Vista/7: %LOCALAPPDATA%\Microsoft\Outlook
    '               XP/2000: %USERPROFILE%\Local Settings\Application Data\Microsoft\Outlook 
    '                   (For English OS).
    ' USAGE:   Outlook-Set-Autoarchive-Path.vbs -NewPath:<PathToNewLocation> 
    '           [-Silent]
    '=========================================================================
    
    Option Explicit 
    
    const HKEY_CURRENT_USER = &H80000001 
    
    Dim objWshShell
    Set objWshShell = WScript.CreateObject("WScript.Shell") 
    
    'Read Parameters
    Dim oArgs, strArg, argSilent, argNewLocation
    Set oArgs = WScript.Arguments
    If oArgs.Count = 0 Then
        MsgBox "No arguments specified." & vbCrLf & vbCrLf & "USAGE:  Outlook-Set-Autoarchive-Path.vbs -NewPath:<PathToNewLocation> [-Silent] ", vbOKOnly, "Outlook Autoarchive"
        WScript.Quit
    Else
        argSilent = False
        For Each strArg In oArgs
            Select Case LCase(Split(strArg, ":")(0))
                Case "-silent"
                    argSilent = True
                Case "-newpath"
                    argNewLocation = Replace(strArg, Split(strArg, ":")(0) & ":", "")
            End Select
        Next
        If Len(argNewLocation) = 0 Then
            MsgBox "Must specify -NewPath argument." & vbCrLf & vbCrLf & "USAGE:  Outlook-Set-Autoarchive-Path.vbs -NewPath:<PathToNewLocation> [-Silent] ", vbOKOnly, "Outlook Autoarchive"
            WScript.Quit 
        End If
    End If
    
    argNewLocation = objWshShell.ExpandEnvironmentStrings(argNewLocation)
    
    SetOutlookArchiveLocation argNewLocation
    
    WScript.Quit 
    
    '----------------------------
    '   FUNCITONS
    '----------------------------
    
    Sub SetOutlookArchiveLocation(strNewArchiveLocation)
        
        Dim objRegistry, RegRoot, strPath, strConfigurationKey, strArchiveLocationValueName, bConfirm, iCount
        RegRoot = HKEY_CURRENT_USER
        strPath = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\"
        strConfigurationKey = "0a0d020000000000c000000000000046"
        strArchiveLocationValueName = "001f0324"
        
        Dim strRegistryKeys, strKey
        
        Set objRegistry = GetObject("winmgmts:root\default:StdRegProv") 
        objRegistry.EnumKey RegRoot, strPath, strRegistryKeys
    
        ON ERROR RESUME NEXT
    
        iCount = 0
        For Each strKey in strRegistryKeys
            ' Delete and recreate value as EXPANDED STRING with new Archive Location
            If Not argSilent Then
                bConfirm = (MsgBox("?Replace AutoArchive location for " & strKey & " profile?", vbYesNo, "Outlook Autoarchive") = vbYes)
            Else
                bConfirm = True
            End If
            If bConfirm = True Then
                objRegistry.DeleteValue RegRoot,strPath & "\" & strKey & "\" & strConfigurationKey, strArchiveLocationValueName
                objRegistry.SetExpandedStringValue RegRoot, strPath & "\" & strKey & "\" & strConfigurationKey, strArchiveLocationValueName, strNewArchiveLocation
                
                iCount = iCount + 1
                If Not argSilent Then
                    MsgBox "AutoArchive location for " & strKey & " profile changed to """ & strNewArchiveLocation & """", vbOKOnly, "Outlook Autoarchive"
                End If
            End If
        Next
        
        'DONE!
         If Not argSilent Then
            MsgBox "AutoArchive location changed successfully  for " & iCount & " profile/s.", vbOKOnly, "Outlook Autoarchive"
        End If
    
    End Sub

    Что бы скрипт заработал в Office 2013 (В 2016 еще не проверил), меняем строчку 

    strPath = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\"

    на strPath = "Software\Microsoft\Office\15.0\Outlook\Profiles\"



    • Помечено в качестве ответа Sciron22 10 июля 2017 г. 12:24
    10 июля 2017 г. 12:24

Все ответы

  • Добрый день.

    Коллеги подскажите пожалуйста как в Outlook можно централизованно изменять расположение файла автоархивации? 

    Необходимо что бы у всех пользователей, файл располагался не по стандартному пути, а в \\netshare\MailArchives$\%USERNAME%\Archive.pst

    Административными шаблонами, это не сделать. Скрипт то же не могу найти.

    Настроить архив на Exchange не предлагать т.к. там нужны лицензии и дисковое пространство и прочее, прочее прочее, чего оперативно получить мы пока не можем. 

    Спасибо!

    Может ваш случай

    https://social.technet.microsoft.com/Forums/windows/en-US/a41766b9-2848-454e-96d0-60d01411d36f/gpo-to-change-outlook-2010-default-autoarchive-location?forum=winserverGP

    27 июня 2017 г. 13:25
  • C 2010 офисом все работает, скриптом прописываем. А вот с 2013 и выше проблемы.

    Спасибо, но это не помогло.

  • Есть решение. 

    Имеется скрипт который меняет путь к файлу автоархива (путь берет из переменной NewPath), но работает только до Office 2013. Предварительно надо сделать "батник" вида 

    @eho off
    \\Yourdomain\sysvol\Outlook-set-autoarchive-path.vbs -NewPath:"\\YourArchivePath\MailArchivesShares$\%USERNAME%\Archive.pst" -Silent

    '=========================================================================
    ' VBScript Source File
    '
    ' AUTHOR:  Adrian Yannuzzi 
    ' COMPANY: MakeIT Consulting (www.makeit.com.ar)
    ' DATE:    22/09/2011
    ' COMMENT: This script is for changing the default Outlook Autoarchive
    '           PST location.
    '           Default Locations:
    '               Vista/7: %LOCALAPPDATA%\Microsoft\Outlook
    '               XP/2000: %USERPROFILE%\Local Settings\Application Data\Microsoft\Outlook 
    '                   (For English OS).
    ' USAGE:   Outlook-Set-Autoarchive-Path.vbs -NewPath:<PathToNewLocation> 
    '           [-Silent]
    '=========================================================================
    
    Option Explicit 
    
    const HKEY_CURRENT_USER = &H80000001 
    
    Dim objWshShell
    Set objWshShell = WScript.CreateObject("WScript.Shell") 
    
    'Read Parameters
    Dim oArgs, strArg, argSilent, argNewLocation
    Set oArgs = WScript.Arguments
    If oArgs.Count = 0 Then
        MsgBox "No arguments specified." & vbCrLf & vbCrLf & "USAGE:  Outlook-Set-Autoarchive-Path.vbs -NewPath:<PathToNewLocation> [-Silent] ", vbOKOnly, "Outlook Autoarchive"
        WScript.Quit
    Else
        argSilent = False
        For Each strArg In oArgs
            Select Case LCase(Split(strArg, ":")(0))
                Case "-silent"
                    argSilent = True
                Case "-newpath"
                    argNewLocation = Replace(strArg, Split(strArg, ":")(0) & ":", "")
            End Select
        Next
        If Len(argNewLocation) = 0 Then
            MsgBox "Must specify -NewPath argument." & vbCrLf & vbCrLf & "USAGE:  Outlook-Set-Autoarchive-Path.vbs -NewPath:<PathToNewLocation> [-Silent] ", vbOKOnly, "Outlook Autoarchive"
            WScript.Quit 
        End If
    End If
    
    argNewLocation = objWshShell.ExpandEnvironmentStrings(argNewLocation)
    
    SetOutlookArchiveLocation argNewLocation
    
    WScript.Quit 
    
    '----------------------------
    '   FUNCITONS
    '----------------------------
    
    Sub SetOutlookArchiveLocation(strNewArchiveLocation)
        
        Dim objRegistry, RegRoot, strPath, strConfigurationKey, strArchiveLocationValueName, bConfirm, iCount
        RegRoot = HKEY_CURRENT_USER
        strPath = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\"
        strConfigurationKey = "0a0d020000000000c000000000000046"
        strArchiveLocationValueName = "001f0324"
        
        Dim strRegistryKeys, strKey
        
        Set objRegistry = GetObject("winmgmts:root\default:StdRegProv") 
        objRegistry.EnumKey RegRoot, strPath, strRegistryKeys
    
        ON ERROR RESUME NEXT
    
        iCount = 0
        For Each strKey in strRegistryKeys
            ' Delete and recreate value as EXPANDED STRING with new Archive Location
            If Not argSilent Then
                bConfirm = (MsgBox("?Replace AutoArchive location for " & strKey & " profile?", vbYesNo, "Outlook Autoarchive") = vbYes)
            Else
                bConfirm = True
            End If
            If bConfirm = True Then
                objRegistry.DeleteValue RegRoot,strPath & "\" & strKey & "\" & strConfigurationKey, strArchiveLocationValueName
                objRegistry.SetExpandedStringValue RegRoot, strPath & "\" & strKey & "\" & strConfigurationKey, strArchiveLocationValueName, strNewArchiveLocation
                
                iCount = iCount + 1
                If Not argSilent Then
                    MsgBox "AutoArchive location for " & strKey & " profile changed to """ & strNewArchiveLocation & """", vbOKOnly, "Outlook Autoarchive"
                End If
            End If
        Next
        
        'DONE!
         If Not argSilent Then
            MsgBox "AutoArchive location changed successfully  for " & iCount & " profile/s.", vbOKOnly, "Outlook Autoarchive"
        End If
    
    End Sub

    Что бы скрипт заработал в Office 2013 (В 2016 еще не проверил), меняем строчку 

    strPath = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\"

    на strPath = "Software\Microsoft\Office\15.0\Outlook\Profiles\"



    • Помечено в качестве ответа Sciron22 10 июля 2017 г. 12:24
    10 июля 2017 г. 12:24