I don't like setting multiple object objects in VBA like your statement below
because it makes it harder to debug

Set OLF = GetObject("", "Outlook.Application") _
.GetNamespace("MAPI") _
.GetDefaultFolder(olFolderInbox) _
.Folders(folder.Value)

Instead use this

Set olApp = CreateObject("Outlook.Application")
Set myNamespace = olApp.GetNamespace("MAPI")
myNamespace.AddStore "c:\" & myNamespace.CurrentUser & ".pst"
Set myfolder = myNamespace.GetDefaultFolder(olFolderInbox)
Set OLF = myfolder.Folders(folder.Value)


It makes it easier to debug. I add the various SET items as a watch items
when I'm debugging my code.

I added to the code above an ADDSTORE function to allow you to open
additional PST files.
"Graeme" wrote:

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