The Import/Export dialog is apparently not accessible from VBA, so I thought it would be amusing to see how far it would be possible to emulate this in VBA, and I have come up with a method that works here with several POP accounts. To what extent it will work with Exchange accounts I have not been able to test.
Basically it creates a new backup PST file (each day) and adds it to Outlook (if the named file exists it opens the named file). A userform then displays the available message stores and the selected Outlook Store inbox (and its sub folders) is then copied to the backup PST file and the backup PSTfile is closed. I have not considered the possibility of automatic running of the macro, or automatically selecting the file to be backed up. It shouldn't affect your default file, but do back it up first just in case of a problem.
The macro uses a userform to pick the Outlook Store. You can download that form (attached) and import it into the Outlook VBA editor. The rest of the code follows:
The backup file is stored in the folder "C:\Path\" which must pre-exist. Change to suit your requirements.
Option Explicit
Sub BackUpEmailInPST()
Dim olNS As Outlook.NameSpace
Dim olBackup As Outlook.Folder
Dim bFound As Boolean
Dim strPath As String
Dim strDisplayName As String
strDisplayName = "Backup " & Format(Date, "yyyymmdd")
strPath = "C:\Path\" & strDisplayName & ".pst"
Set olNS = GetNamespace("MAPI")
olNS.AddStore strPath
Set olBackup = olNS.folders.GetLast
olBackup.Name = strDisplayName
RunBackup olNS, olBackup
olNS.RemoveStore olBackup
lbl_Exit:
Set olNS = Nothing
Set olBackup = Nothing
Exit Sub
End Sub
Sub RunBackup(olNS As Outlook.NameSpace, olBackup As Outlook.Folder)
Dim oFrm As New frmSelectAccount
Dim strAcc As String
Dim olStore As Store
Dim olFolder As Folder
Dim i As Long
With oFrm
.BackColor = RGB(191, 219, 255)
.Height = 190
.Width = 240
.Caption = "Backup E-Mail"
With .CommandButton1
.Caption = "Next"
.Height = 24
.Width = 72
.Top = 126
.Left = 132
End With
With .CommandButton2
.Caption = "Quit"
.Height = 24
.Width = 72
.Top = 126
.Left = 24
End With
With .ListBox1
.Height = 72
.Width = 180
.Left = 24
.Top = 42
For Each olStore In olNS.Stores
If Not olStore.DisplayName = olBackup Then
.AddItem olStore
End If
Next olStore
End With
With .Label1
.BackColor = RGB(191, 219, 255)
.Height = 24
.Left = 24
.Width = 174
.Top = 6
.Font.Size = 10
.Caption = "Select e-mail store to backup"
.TextAlign = fmTextAlignCenter
End With
.Show
If .Tag = 0 Then GoTo lbl_Exit
With oFrm.ListBox1
For i = 0 To .ListCount - 1
If .Selected(i) Then
strAcc = .List(i)
Exit For
End If
Next i
End With
Set olFolder = olNS.Stores(strAcc).GetDefaultFolder(olFolderInbox)
olFolder.CopyTo olBackup
DoEvents
Set olFolder = olNS.Stores(strAcc).GetDefaultFolder(olFolderSentMail)
olFolder.CopyTo olBackup
End With
lbl_Exit:
Unload oFrm
Set olStore = Nothing
Set olFolder = Nothing
Exit Sub
End Sub