Full code appended below.

My goal is that this code (when triggered) will allow the user to select a
destination folder and enter a filename, and select a source outlook folder.

The code should then scrape each email in that folder to get the sent
date/time, the subject line, and the sender, and dump that info into a flat
file (which will be used in Excel).

(1) Apparently outlook doesn't have an application.filedialogue (code errors
out in the function on this line). What is the best way to allow a user to
select a destination folder for a generated file? Alternatively, is there a
way to determine the path to the desktop and always save to the desktop,
given that each user's path to the desktop will be unique?

(2) I'll need my code to work in both Outlook 2003 and 2007. I don't have
direct access to a 2007 box, but would welcome feedback if you see anything
in this code that is likely to fail in 2007

Thank you!
Keith

Sub ParseAlertEmails() '(strSource As String, strLabel As String)
Set myOlApp = CreateObject("Outlook.Application")
Set olns = myOlApp.GetNamespace("MAPI")
Set myinbox = olns.PickFolder
Set myItems = myinbox.Items
Dim fso, tf
Set fso = CreateObject("Scripting.FileSystemObject")
UseFolder = GetFolder
UseDateApp = Format(Now(), "YYMMDDHHmmss")
UseFN = InputBox("Please enter the name of the destination file", "Save As")
Set tf = fso.CreateTextFile(UseFN & " " & UseDateApp, True)

StartCount = 0
strEmailContents = ""
For Each outlookmessage In myinbox.Items

If IgnoreEmail = False Then
strEmailContents = outlookmessage.ReceivedTime
strEmailContents = strEmailContents & ";" & outlookmessage.sender
strEmailContents = strEmailContents & ";" & outlookmessage.Subject

tf.Write strEmailContents & vbCrLf
End If


strEmailContents = ""
StartCount = StartCount + 1
Next

tf.Close
Set fso = Nothing

Set myOlApp = Nothing
Set olns = Nothing
Set myinbox = Nothing
Set myItems = Nothing

End Sub


Private Function GetFolder(Optional strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker) 'this is where
it errors
With fldr
.Title = "Select a Folder in which to save the output file"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

Question 1 solved- Found a way to do it here
(http://www.vbforums.com/archive/index.php/t-400121.html) for the benefit of
future searchers.

I'll try to get access to a 2007 machine to test the new code, and I'll
create a new thread if I run into issues.

Thank you,
Keith

"ker_01" wrote:


Full code appended below.

My goal is that this code (when triggered) will allow the user to select a
destination folder and enter a filename, and select a source outlook folder.

The code should then scrape each email in that folder to get the sent
date/time, the subject line, and the sender, and dump that info into a flat
file (which will be used in Excel).

(1) Apparently outlook doesn't have an application.filedialogue (code errors
out in the function on this line). What is the best way to allow a user to
select a destination folder for a generated file? Alternatively, is there a
way to determine the path to the desktop and always save to the desktop,
given that each user's path to the desktop will be unique?

(2) I'll need my code to work in both Outlook 2003 and 2007. I don't have
direct access to a 2007 box, but would welcome feedback if you see anything
in this code that is likely to fail in 2007

Thank you!
Keith

Sub ParseAlertEmails() '(strSource As String, strLabel As String)
Set myOlApp = CreateObject("Outlook.Application")
Set olns = myOlApp.GetNamespace("MAPI")
Set myinbox = olns.PickFolder
Set myItems = myinbox.Items
Dim fso, tf
Set fso = CreateObject("Scripting.FileSystemObject")
UseFolder = GetFolder
UseDateApp = Format(Now(), "YYMMDDHHmmss")
UseFN = InputBox("Please enter the name of the destination file", "Save As")
Set tf = fso.CreateTextFile(UseFN & " " & UseDateApp, True)

StartCount = 0
strEmailContents = ""
For Each outlookmessage In myinbox.Items

If IgnoreEmail = False Then
strEmailContents = outlookmessage.ReceivedTime
strEmailContents = strEmailContents & ";" & outlookmessage.sender
strEmailContents = strEmailContents & ";" & outlookmessage.Subject

tf.Write strEmailContents & vbCrLf
End If


strEmailContents = ""
StartCount = StartCount + 1
Next

tf.Close
Set fso = Nothing

Set myOlApp = Nothing
Set olns = Nothing
Set myinbox = Nothing
Set myItems = Nothing

End Sub


Private Function GetFolder(Optional strPath As String) As String
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker) 'this is where
it errors
With fldr
.Title = "Select a Folder in which to save the output file"
.AllowMultiSelect = False
.InitialFileName = strPath
If .Show -1 Then GoTo NextCode
sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function