Macro to Export Messages in a Folder to txt Format?

  • Thread starter Thread starter Elisa Francesca Roselli
  • Start date Start date
E

Elisa Francesca Roselli

I'm sure this is a FAQ, but I've been googling all morning and cannot
find an answer.

I would like a macro to automate the following actions in Outlook:

Open a message in an Outlook folder
Export it to txt format into a given directory
Close it and move on to the next message in the directory
And so on, recursively through the whole folder.

All the information I've seen about converting pst to text says to
export the individual messages by hand.

But I have THOUSANDS of these messages and exporting them by hand will
take too long.

I cannot find a macro recording function in my Outlook, 2000 SR. I have
no experience of macro programming in Outlook at all; I have done a few
VBA macros in Word, Powerpoint and Access, however.

Many thanks for your help and advice.

Elisa Francesca Roselli
Ile de France
 
Salut Elisa,

the Code requires that the Direction in sPath exists already.

'<DieseOutlookSitzung>
Public Sub ExportMailToTxt()
On Error Resume Next
Dim oFld As Outlook.MAPIFolder
Dim obj As Object
Dim oMail As Outlook.MailItem
Dim sName As String
Dim sFile As String
Dim dtDate As Date
Dim sPath As String: sPath = "c:\mails\"

Set oFld = Application.Session.PickFolder
If Not oFld Is Nothing Then
For Each obj In oFld.Items
If TypeOf obj Is Outlook.MailItem Then
Set oMail = obj
sName = oMail.Subject
ReplaceChars sName
dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbMonday, vbFirstJan1) _
& Format(dtDate, "-hhnnss", vbMonday, vbFirstJan1) _
& "-" & sName & ".txt"
oMail.SaveAs sPath & sName, olTXT
End If
Next
End If
End Sub

Private Sub ReplaceChars(ByRef sName As String)
sName = Replace(sName, "/", "_")
sName = Replace(sName, "\", "_")
sName = Replace(sName, ":", "_")
sName = Replace(sName, "?", "_")
sName = Replace(sName, Chr(34), "_")
sName = Replace(sName, "<", "_")
sName = Replace(sName, ">", "_")
sName = Replace(sName, "|", "_")
End Sub
'</DieseOutlookSitzung>
 
Back
Top