open outlook data files from vbscript / macro

[sjj1805]

The following macro opens 6 outlook pst files that I use to archive emails.

Code: Select all

Sub open_all_folders()

 Dim myNameSpace As Outlook.NameSpace



    Set myNameSpace = Application.GetNamespace("MAPI")

    myNameSpace.AddStore "b:\Archivegail.pst"

    myNameSpace.AddStore "b:\ArchiveKeep.pst"

    myNameSpace.AddStore "b:\ArchivePaulSheldon.pst"

    myNameSpace.AddStore "b:\ArchivePurchases.pst"

    myNameSpace.AddStore "b:\ArchiveSent.pst"

    myNameSpace.AddStore "b:\ArchiveWork.pst"

End Sub

[sjj1805]

The following macro closes the above outlook pst files that I use to archive emails.
I have included the error checking lines so that it will work even when only one or just a few of the outlook pst files are open.

Code: Select all

Sub close_all_folders()

 Dim objName As Outlook.NameSpace

    Dim objFolder As Outlook.Folder

    On Error Resume Next

    Set objName = Application.GetNamespace("MAPI")

    Set objFolder = objName.Folders.Item("Gail")

    objName.RemoveStore objFolder

    Set objFolder = objName.Folders.Item("Keep")

    objName.RemoveStore objFolder

    Set objFolder = objName.Folders.Item("Paul Sheldon")

    objName.RemoveStore objFolder

    Set objFolder = objName.Folders.Item("Purchases")

    objName.RemoveStore objFolder

    Set objFolder = objName.Folders.Item("Sent Items")

    objName.RemoveStore objFolder

    Set objFolder = objName.Folders.Item("Work")

    objName.RemoveStore objFolder

    On Error GoTo 0

End Sub

[sjj1805]

You might only want to open specific archives rather than all of them.

Gail

Code: Select all

Sub open_Gail()

 Dim myNameSpace As Outlook.NameSpace

    Set myNameSpace = Application.GetNamespace("MAPI")

    myNameSpace.AddStore "b:\Archivegail.pst"

End Sub

Keep

Code: Select all

Sub open_Keep()

 Dim myNameSpace As Outlook.NameSpace

    Set myNameSpace = Application.GetNamespace("MAPI")

    myNameSpace.AddStore "b:\ArchiveKeep.pst"

End Sub

Paul Sheldon

Code: Select all

Sub open_PSheldon()

 Dim myNameSpace As Outlook.NameSpace

    Set myNameSpace = Application.GetNamespace("MAPI")

    myNameSpace.AddStore "b:\ArchivePaulSheldon.pst"

End Sub

Purchases

Code: Select all

Sub open_Purchases()

 Dim myNameSpace As Outlook.NameSpace

    Set myNameSpace = Application.GetNamespace("MAPI")

    myNameSpace.AddStore "b:\ArchivePurchases.pst"

End Sub

Sent

Code: Select all

Sub open_Sent()

 Dim myNameSpace As Outlook.NameSpace

    Set myNameSpace = Application.GetNamespace("MAPI")

    myNameSpace.AddStore "b:\ArchiveSent.pst"

End Sub

Work

Code: Select all

Sub open_Work()

 Dim myNameSpace As Outlook.NameSpace

    Set myNameSpace = Application.GetNamespace("MAPI")

    myNameSpace.AddStore "b:\ArchiveWork.pst"

End Sub