Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Extract Outlook mail using VBA from non default Inbox
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Extract Outlook mail using VBA from non default Inbox
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Extract Outlook mail using VBA from non default Inbox
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Extract Outlook mail using VBA from non default Inbox
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Extract Outlook mail using VBA from non default Inbox
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. "Joel" wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
How to stop outlook to be my default mail client | New Users to Excel | |||
repair outlook inbox | Excel Worksheet Functions | |||
How can I use Outlook express to send mail rather than Outlook by VBA code | Excel Programming | |||
Mail goes to own inbox | Excel Discussion (Misc queries) | |||
How to make Microsoft Outlook default e-mail when sending excell . | Excel Discussion (Misc queries) |