Look at this website


From what I cna tell it automatically put the PST under your personal
folders. The best way of seeing this is to add a watch for myNamespace
(highlight variable and right click mouse, then select add watch).

You will see under Folder items. One of the items is the Personal Folders
(item 3 on my PC). The PST files will be under this directory.

the website above says something about opening, closing, then re-open.
Haven't tried this.



"Graeme" wrote:

Hello,

I tried the below code but have encountered a complication. The .pst files I
am trying to query are version 97-2002. I tried modifying the code by using
AddStoreEx instead of Addstore but it still isn't working as expected. The
VBA creates a new "personal" folder within outlook. If I look at advanced
properties it has the correct path i.e. "d:\outlookmail\oldemail.pst" but
the subfolders aren't shown. i.e. it suggests that the old pst file is empty
when it actually contains many megabytes of information.

Any comments appreciated.

Thanks,

Graeme.
"Joel" wrote in message
...
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