Использование VBScript перечислить все профили Outlook и PST - PullRequest
Новая
       59

Использование VBScript перечислить все профили Outlook и PST

3 голосов
/ 07 ноября 2011

Я пытаюсь написать скрипт для проверки профилей Outlook, найти соответствующие PST и записать его в TXT.У нас есть пользователи, которым необходимо иметь 2 отдельных профиля и которые должны хранить некоторые PST в отдельном сетевом ресурсе.Я нашел скрипт, который работал бы великолепно, но только перечислял DefaultProfile.Мне было интересно, если кто-нибудь знает способ сделать это в VBScript.Для тех, кто ищет здесь, есть скрипт для профиля по умолчанию. 

Option Explicit 
 'On Error Resume Next 
 Const HKEY_CURRENT_USER = &H80000001 
 Const r_PSTGuidLocation = "01023d00" 
 Const r_MasterConfig = "01023d0e" 
 Const r_PSTCheckFile = "00033009" 
 Const r_PSTFile = "001f6700" 
 Const r_keyMaster = "9207f3e0a3b11019908b08002b2a56c2" 
 Const r_ProfilesRoot = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles" 
 Const r_DefaultOutlookProfile = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles" 
 Const r_DefaultProfileString = "DefaultProfile" 
 Dim oReg        :Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv") 
 Dim objFSO    :Set objFSO = CreateObject("Scripting.FileSystemObject") 
 Dim objPSTLog    :Set objPSTLog = objFSO.OpenTextFile(ExpandEvnVariable("Temp") & "\pst.log",2,True)     
 Dim arrSubKeys, subkey, strValue, i, pstFile, arrPSTs, DefaultProfileName 


 oReg.GetStringValue HKEY_CURRENT_USER,r_DefaultOutlookProfile,r_DefaultProfileString,DefaultProfileName 

 objPSTLog.WriteLine(DefaultProfileName) 
 GetPSTsForProfile(DefaultProfileName) 


 objPSTLog.close 
 Set objPSTLog = Nothing     
 '_____________________________________________________________________________________________________________________________ 
 Function GetPSTsForProfile(p_profileName) 
 Dim strHexNumber, strPSTGuid, strFoundPST 
 Dim HexCount    :HexCount = 0 

 oReg.GetBinaryValue HKEY_CURRENT_USER,r_ProfilesRoot & "\" & p_profileName & "\" & r_keyMaster,r_MasterConfig,strValue 
     For i = lBound(strValue) to uBound(strValue)     
             If Len(Hex(strValue(i))) = 1 Then  
                 strHexNumber = "0" & Hex(strValue(i)) 
             Else 
                 strHexNumber = Hex(strValue(i)) 
             End If         
         strPSTGuid = strPSTGuid + strHexNumber 
         HexCount = HexCount + 1 
             If HexCount = 16 Then  
                     If IsAPST(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid) Then 
                         'wscript.echo vbCrLf & "PST FOUND: " & PSTlocation(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid) 
                         'strFoundPST = strFoundPST & "??" & PSTFileName(r_ProfilesRoot & "\" & p_profileName & "\" & PSTlocation(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid)) 
                         objPSTLog.WriteLine(PSTFileName(r_ProfilesRoot & "\" & p_profileName & "\" & PSTlocation(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid))) 
                     End If     
                 HexCount = 0 
                 strPSTGuid = "" 
             End If             
     Next 
     'GetPSTsForProfile = strFoundPST 
 End Function 
 '_____________________________________________________________________________________________________________________________ 
 Function IsAPST(p_PSTGuid) 
 Dim x, P_PSTGuildValue 
 Dim P_PSTCheck:P_PSTCheck=0 
 IsAPST=False 
 oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTCheckFile,P_PSTGuildValue 
     For x = lBound(P_PSTGuildValue) to uBound(P_PSTGuildValue)     
         P_PSTCheck = P_PSTCheck + Hex(P_PSTGuildValue(x)) 
     Next     
     If P_PSTCheck=20 Then 
         IsAPST=True 
     End If     
 End Function  
 '_____________________________________________________________________________________________________________________________ 
 Function PSTlocation(p_PSTGuid) 
 Dim y, P_PSTGuildValue, t_strHexNumber 
 oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTGuidLocation,P_PSTGuildValue 
     For y = lBound(P_PSTGuildValue) to uBound(P_PSTGuildValue)     
         If Len(Hex(P_PSTGuildValue(y))) = 1 Then 
             PSTlocation = PSTlocation + "0" & Hex(P_PSTGuildValue(y)) 
         Else 
             PSTlocation = PSTlocation + Hex(P_PSTGuildValue(y))     
         End If     
     Next     
 End Function  
 '_____________________________________________________________________________________________________________________________ 
 Function PSTFileName(p_PSTGuid) 
 Dim z, P_PSTName 
 Dim strString:strString = "" 
 oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTFile,P_PSTName 
     For z = lBound(P_PSTName) to uBound(P_PSTName)     
         If P_PSTName(z) > 0 Then 
             strString = strString & Chr(P_PSTName(z)) 
         End If     
     Next     
     PSTFileName = strString 
 Set z = nothing 
 Set P_PSTName = nothing 
 End Function  
 '_________________________________________________________________________________________________________ 
 Function ExpandEvnVariable(ExpandThis) 
 Dim objWSHShell    :Set objWSHShell = CreateObject("WScript.Shell") 
 ExpandEvnVariable = objWSHShell.ExpandEnvironmentStrings("%" & ExpandThis & "%") 
 End Function 
 '_________________________________________________________________________________________________________

Ответы [ 2 ]

3 голосов
/ 08 ноября 2011

Сценарий, который вы указали в своем вопросе, содержит функцию с именем GetPSTsForProfile, которая принимает имя профиля, а затем выполняет свою магию для получения информации PST. Итак, у вас есть эта часть загадки.

Теперь все, что вам нужно сделать, это перечислить все профили . Профили хранятся в виде подразделов внутри HKCU\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles.

Используя термины и переменные из сценариев, которые вы разместили выше, вот как сделать перечисление: 

Const HKEY_CURRENT_USER = &H80000001
Const r_ProfilesRoot = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"

strComputer = "."

Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & _ 
    strComputer & "\root\default:StdRegProv")

oReg.EnumKey HKEY_CURRENT_USER,r_ProfilesRoot,subKeys

For Each profileName In subKeys
   objPSTLog.WriteLine( profileName )  
   GetPSTsForProfile( profileName ) 
Next
1 голос
/ 27 января 2016

В Outlook 2013 раздел реестра изменился. Вы сможете найти профили в

HKCU \ Software \ Microsoft \ Office \ 15.0 \ Outlook \ Profiles

C # .NET 

string profilesRoot = "Software\\Microsoft\\Office\\15.0\\Outlook\\Profiles";
Registry.CurrentUser.OpenSubKey(profilesRoot).GetSubKeyNames()
...