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