Microsoft Office Forums - View Single Post - How to send an email to an open archive folder as an addressee

gmayor · 06-26-2016, 10:26 PM

I am not sure what the relevance of the To or CC address lists have to do with being able to move a message to a folder in your archive file.

You can process any open Outlook file in VBA, or open the file if it is not currently open and then process it. Something like the following would do that. Change the path of the archive file to that of your archive and the name of the sub folder to the sub folder you want to move the message to. Select a message and run the ProcessSelectedMessage macro. You could create a loop to process multiple messages if you preferred.

Code:

Option Explicit

Sub ProcessSelectedMessage()
Dim olMsg As MailItem
    On Error Resume Next
    Set olMsg = ActiveExplorer.Selection.Item(1)
    MoveToArchive olMsg
lbl_Exit:
    Exit Sub
End Sub

Sub MoveToArchive(olItem As Object)
Dim olStore As Store
Dim olFolder As Folder
Dim fso As Object
Const strPath As String = "T:\Outlook Backup\Archive.pst"    ' the path of the archive file
Start:
    For Each olStore In Session.Stores
        If olStore.FilePath = strPath Then    'see if the archive is open
            Exit For
        End If
    Next olStore
    If olStore Is Nothing Then
        If MsgBox("The Archive folder " & strPath & " is not currently open." & vbCr & vbCr & _
                  "Do You wish to open it now?", vbYesNo) = vbYes Then
            Set fso = CreateObject("Scripting.FileSystemObject")
            If fso.FileExists(strPath) Then
                Session.AddStore strPath
                GoTo Start:
            Else
                MsgBox "The archive file " & strPath & " is no longer available."
                GoTo lbl_Exit
            End If
        Else
            GoTo lbl_Exit
        End If
    End If
    'the archive folder is open, so process the msg
    Set olFolder = olStore.GetDefaultFolder(olFolderInbox).folders("MySubFolder")
    olItem.Move olFolder

lbl_Exit:
    Set olStore = Nothing
    Set olFolder = Nothing
    Set olItem = Nothing
    Set fso = Nothing
    Exit Sub
End Sub