Amending Existing Code for Extracting Information from Outlook Folder

Hi all.

I recently received a solution to my question here:

http://www.excelforum.com/excel-prog...-a-folder.html

regarding looping through subfolders of a particular folder in my Outlook session and extracting certain information.

I now need to be able to do precisely the same operation, but this time the folder that I want to run the code on is not one of my default Outlook session folders, but rather a .pst file that I currently have open in Outlook via an external hard drive.

Here is the code that romperstomper kindly provided me with, which works great when the folder in question is one from my own Outlook session:

Sub Download_Outlook_Mail_To_Excel()
    Dim olApp                 As Outlook.Application
    Dim Folder                As Outlook.MAPIFolder
    Dim SubFolder             As Outlook.MAPIFolder
    Dim MailBoxName           As String
    Dim Pst_Folder_Name       As String
    Dim rngOut                As Range

    MailBoxName = "John.Doe@XMail.com"
    Pst_Folder_Name = "Deleted Items"
    Set olApp = GetObject(, "Outlook.Application")
    Set Folder = olApp.Session.Folders(MailBoxName).Folders(Pst_Folder_Name)

    If Folder = "" Then
        MsgBox "Invalid Data in Input"
        GoTo end_lbl1:
    End If

    Application.ScreenUpdating = False

    Sheets(1).Activate

    Range("A1").Value = "From"
    Range("B1").Value = "Subject"
    Range("C1").Value = "Received"
    Range("D1").Value = "Text"
    Set rngOut = Range("A2")

    PrintFolderList Folder, rngOut
end_lbl1:
    Application.ScreenUpdating = True

End Sub
Sub PrintFolderList(fdr As Outlook.MAPIFolder, rng As Range)
    Dim i                     As Long
    Dim itm
    Dim fSub                  As Outlook.MAPIFolder
    fdr.Items.Sort "Received"

    For Each itm In fdr.Items
        With itm
            rng.Resize(, 4).Value = Array(.SenderName, .Subject, .ReceivedTime, .Body)
        End With
        Set rng = rng.Offset(1)
    Next itm
    If fdr.Folders.Count > 0 Then
        For Each fSub In fdr.Folders
            Debug.Print rng.Address, fSub.Name
            PrintFolderList fSub, rng
        Next fSub
    End If

End Sub

Can anyone tell me how to adjust the code to work for this case? I have tried amending the lines:

MailBoxName = "John.Doe@XMail.com"

and

Pst_Folder_Name = "Deleted Items"

to various things, but nothing seems to work.

Help appreciated as always.

Cheers

What does the top level folder name look like in the Outlook window with the .pst file loaded?

Not sure what you mean by "top-level", sorry.

My Navigation Pane appears to give "John.Doe@XMail.com" and the name of the .pst file I am accessing as being at the same "level" within the folder structure, though neither is a subfolder of the other.

Is that what you meant?

Regards

Did you replace the "John.Doe@XMail.com" in the code with the exact caption of the .pst file as it appears in the Outlook navigation pane?

Ouch. For some reason, no. I instead changed the Pst_Folder_Name to that...

Just tried what you said and works great.

Stupidity reigns supreme. Think it's time I picked up that manual!

Thanks a lot again!

Cheers

Glad to help.