-2

I am wondering if there is a way using VBA/Outlook to look through a number of personal folders (all added to Outlook and called personal folders) and copy the contents of the inboxes (the folder will always be called Inbox) to a single PST/inbox/folder. The number of personal folders would vary depending upon the email search completed (GVault).

Personal Folder - Inbox, Personal Folder - Inbox, Personal Folder - inbox, Final Personal Folder - Inbox

The aim is to give the user one PST with all the emails in.

This is part of an attempt to streamline our email archive search process which creates a folder + PST for each email address found in the search (good old Google....) It is obviously a nightmare combining them all into one PST which we can then give to a user. It is possible (using Outlook) to manually combine each PST with a master PST but this is far from automating the process + there could be a large amount of separate email addresses.

The original problem was taking all the PSTs and getting them into Outlook, this has been solved but the format is as described above (seperate PSTs all added).

Any help would be greatly appreciated as I cant get past this final hurdle, there are scripts that do manipulate PSTs in Outlook, they just dont do this.

Thanks Dan

Daniel Gange
  • 1
  • 1
  • I don't see this as a *final hurdle*, but more of a starting line. What have you tried so far? – dwirony Nov 21 '17 at 13:43
  • I appreciate this doesn't look like much effort on my behalf, but this has been going on for hours and hours now, I only started looking at VBA 2 weeks ago so I tend to hit brick walls very quickly. Adding code from others which don't do what Im after in my opinion would only cause confusion...for me. – Daniel Gange Nov 21 '17 at 14:43

1 Answers1

0

Below code will loop your outlook attached PST files copying files in a folder called 'Inbox' (any case) to the PST callled 'Master PST'

Included very trivial error checking <-- free to improve

'include reference to Microsoft Outlook XX.0 Object Library
Public Sub copyInbox()
    Dim ns As Outlook.Namespace

    On Error GoTo hell

    Dim sourceFolder As Outlook.MAPIFolder
    Dim copyToFolder As Outlook.MAPIFolder
    Dim subfolder As Outlook.MAPIFolder
    Dim objItem As Outlook.MailItem
    Dim objItemCopy  As Outlook.MailItem
    Set ns = Application.GetNamespace("MAPI")
    Set copyToFolder = ns.Folders("MASTER PST").Folders("Inbox")
    'Personal folder called 'MASTER PST' with inbox subfolder must exist
    For Each sourceFolder In ns.Folders
        For Each subfolder In sourceFolder.Folders
            If Trim(UCase(subfolder.Name)) = "INBOX" Then
                For Each objItem In subfolder.Items
                    'modified below to use copy as per MSDN
                    'https://msdn.microsoft.com/en-us/vba/outlook-vba/articles/mailitem-copy-method-outlook
                    Set objItemCopy = objItem.Copy
                    objItemCopy.Move copyToFolder
                Next
            End If
            'copy items in subfolders in inbox can be added here
        Next
    Next
    Exit Sub:
hell:
    MsgBox Err.Description, vbExclamation, Err.Source
End Sub
steve biko
  • 171
  • 5
  • Thank Steve, Ill test and let you know. – Daniel Gange Nov 21 '17 at 14:43
  • Hi @stevebiko, I got an error on first run through, tried removing end if and next but errors keep popping up. [link](https://drive.google.com/open?id=1Jyrk3r5r8dFV94tKZ9xI2EQS83kLXJfr) layout [link](https://drive.google.com/open?id=1HrMfrFs1g8CdIwxNJnXRb3tBJc5CZNlJ) with end if [link](https://drive.google.com/open?id=1MfSA7gun_L1slk2sI6zuV634lEFzJZUc) without end if Thanks again – Daniel Gange Nov 21 '17 at 15:51
  • sorry about formatting, ive got no luck with coding Linebreaks End a line with two spaces to add a
    linebreak:     – Daniel Gange Nov 21 '17 at 15:59
  • I've tried the new code but it's returning an error stating "The object does not support this method" I've tried to replace part of the code where it says "objItem.copy copyToFolder" to "ActiveDocument.Copy copyToFolder" but it now returns an error "Object required" @stevebiko – Daniel Gange Nov 22 '17 at 10:29