Convert Office Outlook VBA Macro To PowerShell

In my profession I have always been presented with problems or requests that provide a bit of a challenge. One such challenge was automating local PST archiving (not to be confused with online archiving). There is a MAPI property on each folder in the mailbox that will identify whether the folder is to be locally archived or not. This property resides within the mailbox itself and there is no automated way of setting this across the mailbox without user intervention. Outlook provides a button that sets all folders to locally archive but new folders created will not inherit the setting.

The only documentation I could find was located on MSDN here in VBA format. My final solution was to create an Outlook add-in to avoid having to use Group Policy to allow outside access to the application. If you are looking for this solution you can download the add-in here. Through the process I was able to take the VBA macro and convert it into VBS, C# and PowerShell. Here is the before and after when converting VBA to PowerShell that can be applied across any VBA macros that you might find.

VBA Code Before:

Function ChangeAgingProperties(oFolder As Outlook.Folder, _ 
 AgeFolder As Boolean, DeleteItems As Boolean, _ 
 FileName As String, Granularity As Integer, _ 
 Period As Integer, Default As Integer) As Boolean 
 
 '6 MAPI properties for aging items in a folder 
 Const PR_AGING_AGE_FOLDER = _ 
 "http://schemas.microsoft.com/mapi/proptag/0x6857000B" 
 Const PR_AGING_DELETE_ITEMS = _ 
 "http://schemas.microsoft.com/mapi/proptag/0x6855000B" 
 Const PR_AGING_FILE_NAME_AFTER9 = _ 
 "http://schemas.microsoft.com/mapi/proptag/0x6859001E" 
 Const PR_AGING_GRANULARITY = _ 
 "http://schemas.microsoft.com/mapi/proptag/0x36EE0003" 
 Const PR_AGING_PERIOD = _ 
 "http://schemas.microsoft.com/mapi/proptag/0x36EC0003" 
 Const PR_AGING_DEFAULT = _ 
 "http://schemas.microsoft.com/mapi/proptag/0x685E0003" 
 
 Dim oStorage As StorageItem 
 Dim oPA As PropertyAccessor 
 
 ' Valid Period: 
 ' 1-999 
 ' 
 ' Valid Granularity: 
 ' 0=Months, 1=Weeks, 2=Days 
 ' 
 ' Valid Default: 
 ' 0=All settings do not use a default setting 
 ' 1=Only the file location is defaulted 
 ' "Archive this folder using these settings" and 
 ' "Move old items to default archive folder" are checked 
 ' 3=All settings are defaulted 
 ' "Archive items in this folder using default settings" is checked 
 
 If (oFolder Is Nothing) Or _ 
 (Granularity < 0 Or Granularity > 2) Or _ 
 (Period < 1 Or Period > 999) Or _ 
 (Default < 0 Or Default = 2 Or Default > 3) _ 
 Then 
 ChangeAgingProperties = False 
 End If 
 
 On Error GoTo Aging_ErrTrap 
 
 'Create or get solution storage in given folder by message class 
 Set oStorage = oFolder.GetStorage( _ 
 "IPC.MS.Outlook.AgingProperties", olIdentifyByMessageClass) 
 Set oPA = oStorage.PropertyAccessor 
 
 If Not (AgeFolder) Then 
 oPA.SetProperty PR_AGING_AGE_FOLDER, False 
 Else 
 'Set the 6 aging properties in the solution storage 
 oPA.SetProperty PR_AGING_AGE_FOLDER, True 
 oPA.SetProperty PR_AGING_GRANULARITY, Granularity 
 oPA.SetProperty PR_AGING_DELETE_ITEMS, DeleteItems 
 oPA.SetProperty PR_AGING_PERIOD, Period 
 If FileName <> "" Then 
 oPA.SetProperty PR_AGING_FILE_NAME_AFTER9, FileName 
 End If 
 oPA.SetProperty (PR_AGING_DEFAULT), Default 
 End If 
 'Save changes as hidden messages to the associated portion of the folder 
 oStorage.Save 
 ChangeAgingProperties = True 
 Exit Function 
 
Aging_ErrTrap: 
 Debug.Print Err.Number, Err.Description 
 ChangeAgingProperties = False 
End Function 
 

PowerShell Code After:

Function ChangeAgingProperties ( [string]$Folder, [boolean]$AgeFolder, [boolean] $DeleteItems, [string]$FileName, [int]$Granularity, [int]$Period, [int]$Default)
{
	#6 MAPI properties for aging items in a folder
	$PR_AGING_AGE_FOLDER = "http://schemas.microsoft.com/mapi/proptag/0x6857000B"
	$PR_AGING_PERIOD = "http://schemas.microsoft.com/mapi/proptag/0x36EC0003"
	$PR_AGING_GRANULARITY = "http://schemas.microsoft.com/mapi/proptag/0x36EE0003"
	$PR_AGING_DELETE_ITEMS = "http://schemas.microsoft.com/mapi/proptag/0x6855000B"
	$PR_AGING_FILE_NAME_AFTER9 = "http://schemas.microsoft.com/mapi/proptag/0x6859001E"
	$PR_AGING_DEFAULT = "http://schemas.microsoft.com/mapi/proptag/0x685E0003"
	
	# Valid Period: 
 	# 1 - 999
	# 
	# Valid Granularity:
	# 0=Months, 1=Weeks, 2=Days 
	#
	# Valid Default: 
 	# 0 = All settings do not use a default setting
	# 1=Only the file location is defaulted 
	# "Archive this folder using these settings" and
	# "Move old items to default archive folder" are checked 
	# 3 = All settings are defaulted
	# "Archive items in this folder using default settings" is checked 
	
	if (($objFolder -eq $null) -or ($Granularity -lt 0 -or $Granularity -gt 2) -or ($Period -lt 1 -or $Period -gt 999) -or ($Default -lt 0 -or $Default -eq 2 -or $Default -gt 3))
	{
		return $False
	}
	
	Try
	{
		$app = New-Object -ComObject Outlook.Application
		$namespace = $app.GetNamespace("MAPI")
		$objFolder = $namespace.GetFolder($Folder)
		$oStorage = $objFolder.GetStorage("IPC.MS.Outlook.AgingProperties", $olIdentifyByMessageClass)
		$oPA = $oStorage.PropertyAccessor
		
		If ($AgeFolder -eq $false)
		{
			oPA.SetProperty PR_AGING_AGE_FOLDER, False
		}
		Else
		{
			#Set the 6 aging properties in the solution storage
			$oPA.SetProperty($PR_AGING_AGE_FOLDER, $True)
			$oPA.SetProperty($PR_AGING_GRANULARITY, $Granularity)
			$oPA.SetProperty($PR_AGING_DELETE_ITEMS, $DeleteItems)
			$oPA.SetProperty($PR_AGING_PERIOD, $Period)
			if ($FileName -ne $null)
			{
				$oPA.SetProperty($PR_AGING_FILE_NAME_AFTER9, $FileName)
			}
			$oPA.SetProperty($PR_AGING_DEFAULT, $Default)
		}
		
		#Save changes as hidden messages to the associated portion of the folder
		$oStorage.Save()
		return $True
	}
	
	Catch
	{
		Write-Output $_
		return $False
	}
}

Leave a Reply

Your email address will not be published. Required fields are marked *