Script below will create a folder in outlook to search archived items. Kind of browser inside outlook.
Save it as .vbs and execute or deploy through group policy on logon script.
=========================================================
Const olFolderInbox = 6
Dim FolderStatus
Dim OstFileCount
'Retrieve Username of the logged in user
Set wshShell = WScript.CreateObject( "WScript.Shell" )
strUserName = wshShell.ExpandEnvironmentStrings( "%USERNAME%" )
'WScript.Echo "User Name: " & strUserName
'Define the path of the .ost file
Path = "C:\users\" & strUserName & "\appdata\local\Microsoft\Outlook"
'WScript.Echo "User Name: " & strUserName
'WScript.Echo "Path: " & Path
Function ReportFolderStatus(fldr)
Dim fso, msg
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FolderExists(fldr)) Then
'MsgBox ("1")
FolderStatus = "1"
Else
'MsgBox ("0")
FolderStatus = "0"
End If
ReportFolderStatus = FolderStatus
End Function
'obiFile = "C:\users\" & strUserName & "\appdata\local\Microsoft\Outlook" & "\Outlook.sharing.xml.obi"
'WScript.Echo "File: " & obiFile
'http://blogs.technet.com/b/heyscriptingguy/archive/2005/01/14/how-can-i-tell-if-a-folder-has-any-files-with-a-specific-file-extension.aspx
Function IsOSTFilePresent(Path)
Set wshShell = WScript.CreateObject( "WScript.Shell" )
strUserName = wshShell.ExpandEnvironmentStrings( "%USERNAME%" )
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colFiles = objWMIService. _
ExecQuery("SELECT * FROM CIM_DataFile WHERE Path = '\\Users\\" & strUserName & "\\AppData\\Local\\Microsoft\\Outlook\\' " & _
"AND Drive = 'C:' AND Extension = 'ost'")
'Wscript.Echo "Number of .ost files found: " & colFiles.Count
IsOSTFilePresent = colFiles.Count
End Function
FolderStatus = ReportFolderStatus(Path)
'WScript.Echo "Folder Status: " & FileStatus
OstFileCount = IsOSTFilePresent(Path)
'WScript.Echo "# of Ost Files: " & OstFileCount
'Find out first if the folder exists, then check if the OST file exists, if yes, then proceed in creating the folder
If FolderStatus = 1 Then
If OstFileCount <> 0 Then
On Error Resume Next
Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
strFolderName = objFolder.Parent
Set objMailbox = objNamespace.Folders(strFolderName)
Set objNewFolder = objMailbox.Folders.Add("Tasnee Archive Search")
objNewFolder.WebViewURL = "https://archive.tasnee.com/search"
objNewFolder.WebViewOn = True
If Err.Number <> 0 Then
On Error GoTo 0
'the folder doesn't exist, create it
End If
End If
End If
======================================================
No comments:
Post a Comment