Option Explicit

' В этой константе укажите имя backup-файла
Const BackupFileName = "C:\OutlookRulesWizard.rwz"

' Имя программы
Const AppName = "Outlook Rules Wizard Backup"

' Удаляем backup-файл, если он уже существует

Dim FSO
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")

If FSO.FileExists(BackupFileName) Then FSO.DeleteFile(BackupFileName)

Set FSO = Nothing

' Создаем объект WScript.Shell

Dim Shell
Set Shell = WScript.CreateObject("WScript.Shell")

' Запускаем Outlook

Dim OutlookPath
OutlookPath = _
	Shell.RegRead("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows" & _
		"\CurrentVersion\App Paths\OUTLOOK.EXE\")

If Len(OutlookPath) = 0 Then ErrorBox "Cannot find Outlook."

On Error Resume Next
Shell.Run OutlookPath, 1
If Err.Number <> 0 Then ErrorBox "Cannot run Outlook, error " & _
	Hex(Err.Number) & " (hex)."
On Error GoTo 0

' Будем ждать запуска Outlook максимально WaitCount секунд

Dim WaitCount
WaitCount = 10

' Ждем, пока запустится Outlook

Do While (Not ActivateOutlook) And (WaitCount > 0)
	Shell.Popup "Waiting for Outlook...", 1, AppName, vbInformation
	WaitCount = WaitCount - 1
Loop

If Not ActivateOutlook Then ErrorBox "Cannot run Outlook."

' Делаем backup

WScript.Sleep 500
Shell.SendKeys "%TL%O%E" & BackupFileName & "{ENTER}{ESC}{ESC}"

' Закрываем Outlook

WScript.Sleep 500
Shell.SendKeys "%FX"

' Все

Set Shell = Nothing

' Эта функция активизирует Outlook

Function ActivateOutlook()
	ActivateOutlook = Shell.AppActivate(" - Microsoft Outlook")
End Function

' Эта функция выдает сообщение об ошибке и завершает работу скрипта

Sub ErrorBox(Msg)
	MsgBox Msg, vbCritical, AppName
	WScript.Quit
End Sub