Try these macros:
Sub SaveEmailsWithCodeToDisk()
On Error Resume Next
Dim objNS As Outlook.NameSpace
Dim objItems As Outlook.Items
Dim objEmail As Outlook.MailItem
Dim objInbox As Outlook.MAPIFolder
Dim strFileName As String
Dim intX As Integer
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objItems = objInbox.Items
For intX = 1 To objItems.Count
If objItems.Item(intX).Class = olMail Then
Set objEmail = objItems.Item(intX)
If InStr(objEmail.Subject, "TEXT OCCURRENCE TO SEARCH FOR") > 0
Then
strFileName = GetValidFileName(objEmail.Subject)
objEmail.SaveAs "C:\Temp\" & strFileName & ".msg", olMSG
End If
End If
Next
Set objNS = Nothing
Set objItems = Nothing
Set objEmail = Nothing
Set objInbox = Nothing
End Sub
Function GetValidFileName(InputString) As String
GetValidFileName = Replace(InputString, ":", "_")
GetValidFileName = Replace(GetValidFileName, "/", "_")
GetValidFileName = Replace(GetValidFileName, "\", "_")
GetValidFileName = Replace(GetValidFileName, "!", "_")
GetValidFileName = Replace(GetValidFileName, "*", "_")
GetValidFileName = Replace(GetValidFileName, "?", "_")
GetValidFileName = Replace(GetValidFileName, ";", "_")
GetValidFileName = Replace(GetValidFileName, "<", "_")
GetValidFileName = Replace(GetValidFileName, ">", "_")
GetValidFileName = Replace(GetValidFileName, "|", "_")
GetValidFileName = Replace(GetValidFileName, """", "_")
End Function
--
Eric Legault - B.A, MCP, MCSD, Outlook MVP
Try Picture Attachments Wizard for Outlook!
http://tinyurl.com/9bby8
Job:
http://www.imaginets.com
Blog:
http://blogs.officezealot.com/legault/
"Mike" wrote:
> I wish to automatically save to disk all sent emails that have a 'code'
> within the subject 'title'. This code would route the file to the correct
> directory.
> If this is a feature of Outlook then I have missed it please could you point
> me in the right direction, failing that has anyone done this using a Visual
> Basic macro ?
> regards
>
Similar Threads
