Remove all PST from the Outlook Mailbox using VBScript

If you would like to remove all of the Personal Folders file .PSTs attached to the Outlook Mailbox profile then we can use RemoveStore Method.

‘Sample script to remove Personal Folders files (.pst) from the current MAPI profile or session
RemoveAllPST

Sub RemoveAllPST()
Dim objOL ‘As New Outlook.Application
Dim objFolders ‘As Outlook.MAPIFolders
Dim objFolder ‘As Outlook.MAPIFolder
Dim i ‘As Interger
Dim strPrompt ‘As String

Set objOL = CreateObject(“Outlook.Application”)
Set objFolders = objOL.Session.Folders
For i = objFolders.Count To 1 Step -1
On Error Resume Next
Set objFolder = objFolders.Item(i)

‘Prompt the user for confirmation
If (InStr(1, objFolder.Name, “Mailbox”) = 0) And (InStr(1, objFolder.Name, “Public Folders”) = 0) Then

strPrompt = “”
strPrompt = “Are you sure you want to remove ” & objFolder.Name

If MsgBox(strPrompt, vbYesNo + vbQuestion) = vbYes Then
objOL.Session.RemoveStore objFolder
End If
End If
Next

End Sub

email me

VBScript To Take Screenshots

This script allows to capture the screen and place the screenshot into a MSWord Doc.

Docname = “snapshot.doc”
Foldername = “Folderpath”

Const END_OF_STORY = 6
Const MOVE_SELECTION = 0
count = 1
Docopen = 0

Set oWordBasic = CreateObject(“Word.Basic”)
oWordBasic.SendKeys “%{prtsc}”
oWordBasic.FileQuit
Set oWordBasic = nothing ‘ clean up’

StrFullname = Foldername & Docname

On Error resume Next
Dim oWdApp : Set oWdApp = GetObject(,”Word.Application”)

‘Msgbox(err.description)
If err.Number <> 0 then
Set oWdApp = CreateObject(“Word.Application”)
Set oWordBasic = CreateObject(“Word.Basic”)
End If
oWdApp.Visible = true
Err.Clear

Do Until count > oWdApp.Documents.Count OR oWdApp.Documents.Count = 0
‘Msgbox(oWdApp.Documents(count).Name)
if StrComp(oWdApp.Documents(count).FullName,StrFullname,1) = 0 then
Set MyDoc = oWdApp.Documents(count)
Docopen = 1
MyDoc.Activate
‘Msgbox(“Doc Open”)
Exit Do
End If
count = count + 1
Loop

if Docopen = 0 then
‘Msgbox(“Doc not open”)
Set MyDoc = oWdApp.Documents.Open(StrFullname)
If err.number = 5273 then
Msgbox(“Given directory ” & Foldername & ” does not exist, Create it First )” )
End If
If err.number = 5174 then
Set MyDoc = oWdApp.Documents.Add()
Mydoc.Saveas(StrFullname)
End If
End If

Set oWdApp.Visible=False

Set objSelection = oWdApp.Selection
objSelection.EndKey END_OF_STORY, MOVE_SELECTION
oWdApp.sendkeys “{ENter}”
objSelection.paste
Mydoc.save

Set oWdApp.Visible=True

Set Mydoc = Nothing
‘Set WshShell = WScript.CreateObject(“WScript.Shell”)
‘WshShell.AppActivate “Microsoft Internet Explorer”

oWdApp = nothing

email me