Hello,

Within an excel worksheet I have created a named range called "Outlook
Folders". The entries
in this named range correspond to the names of the email subfolders within
my default outlook email pst file.
Modifying some VBA which I sourced off the Net I have been able to extract
various fields from my
default outlook email pst file where there is a match back to the subfolder
list contained within my named range.
This is great but I am having trouble trying to generalise the code so that
it also looks at non default pst files.
I have several old pst files which I would like to query with this VBA macro
but I can't seem to get it to work.
e.g I have a pst file called "OldEmail" which shows up when I open outlook.
Some preliminary net searching indicates that I need to somehow modify the
following code, perhaps subsituting "GetSharedDefaultFolder"
for "GetDefaultFolder".

Code extract to be modified:

If folder < "" Then
Set OLF = GetObject("", _
"Outlook.Application").GetNamespace("MAPI").GetDef aultFolder(olFolderInbox).Folders(folder.Value)
End If


Can I have your thoughts please on how to generalise the code?

Thanks Graeme.


Full VBA :

Sub ListAllItemsInInbox()

Dim OLF As Outlook.MAPIFolder, CurrUser As String
Dim EmailItemCount As Integer, i As Integer, EmailCount As Integer
Dim folder As Variant
Dim vrow As Integer
Dim vdate As Variant
Dim acount As Integer

Sheets("Sheet1").Cells(1, 1).Formula = "Subject"
Sheets("Sheet1").Cells(1, 2).Formula = "Received"
Sheets("Sheet1").Cells(1, 3).Formula = "Attachments"
Sheets("Sheet1").Cells(1, 4).Formula = "Read"
Sheets("Sheet1").Cells(1, 5).Formula = "Folder Name"
Sheets("Sheet1").Cells(1, 6).Formula = "Attachment Name"

vrow = 0
For Each folder In Range("OutlookFolders")

If folder < "" Then
Set OLF = GetObject("", _
"Outlook.Application").GetNamespace("MAPI").GetDef aultFolder(olFolderInbox).Folders(folder.Value)
End If

EmailItemCount = OLF.Items.Count
i = 0: EmailCount = 0
' read e-mail information
While i < EmailItemCount
i = i + 1
vrow = vrow + 1

With OLF.Items(i)
EmailCount = EmailCount + 1
Sheets("Sheet1").Cells(vrow + 1, 1).Formula = .Subject
On Error Resume Next
Sheets("Sheet1").Cells(vrow + 1, 2).Formula =
Format(.ReceivedTime, "dd.mm.yyyy hh:mm")
Sheets("Sheet1").Cells(vrow + 1, 3).Formula = .Attachments.Count
Sheets("Sheet1").Cells(vrow + 1, 4).Formula = Not .UnRead
Sheets("Sheet1").Cells(vrow + 1, 5).Value = folder.Value

For acount = 1 To .Attachments.Count
Sheets("Sheet1").Cells(vrow + 1, 5 + acount).Value =
..Attachments(acount).Filename
Next acount

End With
Wend
Next folder

End Sub