Extract Outlook mail using VBA from non default Inbox

[Graeme]

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").GetDefaultFolder(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").GetDefaultFolder(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

 

[Joel]

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]

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]

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]

Hello,

Thanks again for your suggestion.
I couldn't get it to work the way I orginally intended so instead took a
shortcut.
I copied the contents of my old email pst file to my active email and then
just ran the code below.

Regards,

Graeme.