Solved: Use VBA to export items

[pjfry]

I need to develop a macro that will scrape several folders and export the subject line and date received to a text file. I do most of my coding in Access, so I am familiar with basic code, but I have no experience with the Outlook objects.

Here is an example:
There is a folder called 'Collections'. When I run the macro, I want it to go to the Collections folder, collect the subject line and date received of every unread message and export that data to a text file.

Any suggestions?

Thanks in advance,
PJ

[mvidas]

Hi PJ,
Here I set the folder to a variable, then iterate through all the items in the folder. You just have to check to make sure the item is a MailItem (versus contactitem, appointmentitem, taskitem, etc), then check the Unread flag. I'm appending the data to the text file (so as not to replace the file), if you would prefer it done differently (all data written all at once, file overwritten each day, etc), just let me know what you'd like and we can figure out a way to get it:[vba]Sub PJExport()
Dim vFolder As MAPIFolder, vItem As Object
Dim vFF As Long, vFile As String
vFile = "C:\my text file.txt"

'GetFirst returns the "Outlook Today" folder
Set vFolder = Application.Session.Folders.GetFirst.Folders("Collections")
If vFolder.Items.Count = 0 Then Exit Sub 'empty folder
vFF = FreeFile
For Each vItem In vFolder.Items
If TypeName(vItem) = "MailItem" Then
If vItem.UnRead = True Then
Open vFile For Append As #vFF
Print #vFF, vItem.Subject & vbTab & Format(vItem.ReceivedTime, "mm/dd/yyyy")
Close #vFF
End If
End If
Next
End Sub[/vba]Matt

[pjfry]

Matt,

Thanks for the help. I am getting an 'object not found' error when I attempt to run the code. The only part of the code that I am not familiar with occurs when you set vFolder. (I understand the 'set' part, it is OL specific items that I am unfamiliar with.) Is the object it is not find the Collections folder?

Thanks again,

PJ

[mvidas]

The issue is probably that I assumed the Collections folder is in a different location from what you have.. looking at your folder list, do you see it like:
-Outlook Today - [Mailbox - pjfry]
..|-Collections

Or is it something like
-Outlook Today - [Mailbox - pjfry]
..|-some folder
....|-Collections

Or even
-Outlook Today - [Mailbox - pjfry]
..|-Inbox
....|-Collections

I assumed it was the first type (where collections was a top-level folder). If need be I can show you how to iterate through all the folders looking for it, but if you know specifically where that would help a lot.
Matt

[pjfry]

I am going to post a screen shot of my Inbox.

[pjfry]

I need to post two more times to get the image in...

[pjfry]

And one last time...

[pjfry]

Since a picture is worth...



Would you consider the Collections and subsequent folders as part of Outlook Today? Or do they have a different location?

[mvidas]

I didn't realize they were a separate mailbox, sorry about that.
This should hopefully work for that line:[vba] Set vFolder = Application.Session.Folders("Mailbox - Collections")[/vba]
I should also ask -- are you looking to scan any subfolders for unread messages, or just that Collections folder itself?

[pjfry]

Now that you mention it, two of the folders do have subfolders that messages are directed to.

This is really helping me to get better feel for how OL work.

[mvidas]

OL can be a lot of fun to work with in VBA, so I'm happy to help show you how to use it.

If you have multiple folders you want to do this on, the best idea would be to use a function to do the exporting, and a calling sub to list the folders to use. Assuming you wanted to use the "Inbox" folder directly under collections, and an "Another folder" under your own mailbox, you would do something like:[vba]Sub PJExport()
With Application.Session
ExportMessageDetails .Folders("Mailbox - Collections").Folders("Inbox")
ExportMessageDetails .Folders("Mailbox - Fry, PJ").Folders("Another folder")
End With
End Sub
Function ExportMessageDetails(vFolder As MAPIFolder) As Boolean
Dim vItem As Object, vFF As Long, vFile As String
vFF = FreeFile
vFile = "C:\my text file.txt"
For Each vItem In vFolder.Items
If TypeName(vItem) = "MailItem" Then
If vItem.UnRead = True Then
Open vFile For Append As #vFF
Print #vFF, vItem.Subject & vbTab & Format(vItem.ReceivedTime, "mm/dd/yyyy")
Close #vFF
End If
'vItem.UnRead = False 'uncomment this if you want the message marked read
End If
Next
End Function[/vba]Add more folders in the PJExport sub as needed!
Matt

[pjfry]

Brilliant! That does exactly what I need it to do!

I great appreciate the time you took to help out.

Cheers!

[mvidas]

Glad to help! Should you have any more questions about working with outlook, don't hesitate to ask.
Also, since you're new to this forum, once an issue is completed you can go to "Thread Tools" at the top of the page, and select "Mark Thread Solved". This will prepend "Solved: " before the thread title in the forum listing to let others know you don't need any more help with this.

Matt

[pjfry]

One last question. In the export file, how would I add the folder which the message resides in? I was able to get the root folder, but not the specific folder that the message now resides in. Example:

[vba]Sub Request_Folder()

With Application.Session
ExportMessageDetails .Folders("Mailbox - MBX - Refund Requests").Folders("Inbox")
ExportMessageDetails .Folders("Mailbox - MBX - Refund Requests").Folders("Inbox").Folders("Stops and voids in process")
End With
End Sub
Function ExportMessageDetails(vFolder As MAPIFolder) As Boolean
Dim vItem As Object, vFF As Long, vFile As String
vFF = FreeFile
vFile = "S:\Contracts\!2nd_level_dash\RefundRequest.txt"
For Each vItem In vFolder.Items
If TypeName(vItem) = "MailItem" Then
If vItem.UnRead = True Then
Open vFile For Append As #vFF
Print #vFF, vItem.ReceivedByName & vbTab & vItem.Subject & vbTab & Format(vItem.ReceivedTime, "mm/dd/yyyy")
Close #vFF
End If
'vItem.UnRead = False 'uncomment this if you want the message marked read
End If
Next
End Function[/vba]

This will return 'Mailbox - MBX - Refund Requests' for every message and I would be looking to have it return 'Inbox' or 'Stops and voids in process', depending on the folder that the message currently resides in.

Thoughts?

[mvidas]

You should be able to use vFolder.Name in there to get Inbox or Stops and voids in progress. ReceivedByName just lists the mailbox that it was received in (as you've already figured out)
Matt

[mvidas]

Something I thought about last night, you might want to scan the subfolders of a folder too sometimes, so I included a new optional argument to do that if you want:[vba]Function ExportMessageDetails(vFolder As MAPIFolder, Optional ByVal _
ScanSubFolders As Boolean = False) As Boolean
Dim vItem As Object, vFF As Long, vFile As String
vFF = FreeFile
vFile = "S:\Contracts\!2nd_level_dash\RefundRequest.txt"
For Each vItem In vFolder.Items
If TypeName(vItem) = "MailItem" Then
If vItem.UnRead = True Then
Open vFile For Append As #vFF
Print #vFF, vFolder.Name & vbTab & vItem.Subject & vbTab & _
Format(vItem.ReceivedTime, "mm/dd/yyyy")
Close #vFF
End If
End If
Next
If ScanSubFolders Then
Dim vFol As MAPIFolder
For Each vFol In vFolder.Folders
ExportMessageDetails vFol, ScanSubFolders
Next
End If
End Function[/vba]Just add ,True to the exportmessagedetails call line, and any subfolders of the folder you pass it will be scanned as well.

If you want the full path of the folder (have it read "Mailbox - MBX - Refund Requests/Inbox/Stops and voids in process" instead of just "Stops and voids in process"), you can use this function:[vba]Public Function GetMAPIFolderPath(ByRef olFolder As MAPIFolder) As Variant()
Dim AnArray() As Variant, olFold As Object, tArr() As Variant
Dim iUB As Long, i As Long, olNamespace As NameSpace
Set olNamespace = olFolder.Session
ReDim AnArray(0)
AnArray(0) = olFolder.Name
i = 1
Set olFold = olFolder.Parent
Do Until olFold = olNamespace
ReDim Preserve AnArray(i)
AnArray(i) = olFold.Name
i = i + 1
Set olFold = olFold.Parent
Loop
iUB = UBound(AnArray)
ReDim tArr(iUB)
For i = 0 To iUB
tArr(iUB - i) = AnArray(i)
Next
GetMAPIFolderPath = tArr
Set olFold = Nothing
Erase AnArray
Erase tArr
End Function[/vba]
In order to incorporate that into your code, substitute Join(GetMAPIFolderPath(vFolder),"\") in place of vFolder.Name in the ExportMessageDetails function (change the "\" for another delimiter if you'd prefer).
Matt