Outlook 2010 move emails to windows folder and show sender details

Viet Nguyen

Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
Hi,

I have been asked to assist with finding a vb script to copy/move emails from inbox to a windows folder (ie C:\Saved Emails.

I can manually move the emails but the sender address or name doesn't appear in the Windows Folder.

I am hoping you can assist in creating a vb script which will move the emails to windows folder and also display sender names.

Thanking you in advance and hope to hear from you soon.

Regards,
Viet
 

Viet Nguyen

Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
Hi,

I have been asked to assist with finding a vb script to copy/move emails from inbox to a windows folder (ie C:\Saved Emails.

I can manually move the emails but the sender address or name doesn't appear in the Windows Folder.

I am hoping you can assist in creating a vb script which will move the emails to windows folder and also display sender names.

Thanking you in advance and hope to hear from you soon.

Regards,
Viet
UPDATE: This is a to be applied to a shared mailbox which I have access to.
 

Viet Nguyen

Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
Hi Michael,

Ive copied the script into Visual Basic and wanted to run it as a rule in Outlook but I could not see the script to select from the rules when creating the rule.

Is the script at www.vboffice.net/?smp=7, the whole script or just partial and I need to add to it?
Ive only made I amendment to the script. c:\mails\


Option Explicit

Public Enum olSaveAsTypeEnum
olSaveAsTxt = 0
olSaveAsRTF = 1
olSaveAsMsg = 3
End Enum

Private WithEvents Items As Outlook.Items

Private Const MAIL_PATH As String = "c:\mails\"

Private Sub Application_Startup()
Dim Ns As Outlook.NameSpace

Set Ns = Application.GetNamespace("MAPI")
Set Items = Ns.GetDefaultFolder(olFolderInbox).Items
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
If TypeOf Item Is Outlook.MailItem Then
SaveMailAsFile Item, olSaveAsMsg, MAIL_PATH
End If
End Sub

Thanks
Viet

Private Sub SaveMailAsFile(oMail As Outlook.MailItem, _
eType As olSaveAsTypeEnum, _
sPath As String _
)
Dim dtDate As Date
Dim sName As String
Dim sFile As String
Dim sExt As String

Select Case eType
Case olSaveAsTxt: sExt = ".txt"
Case olSaveAsMsg: sExt = ".msg"
Case olSaveAsRTF: sExt = ".rtf"
Case Else: Exit Sub
End Select

sName = oMail.Subject
ReplaceCharsForFileName sName, "_"

dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnnss", _
vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & sExt

oMail.SaveAs sPath & sName, eType
End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub
 

Viet Nguyen

Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
I need to be able to manually pick the emails that come into the inbox rather then it auto move all emails.
 

Michael Bauer

Senior Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
A script that can be run by a rule must be declared this way
Code:
public sub whatever(item as mailitem)
...
end sub
 

Viet Nguyen

Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
This script has worked for me.

Public Sub SaveMsg(Item As Outlook.MailItem)
Dim dtDate As Date
Dim sName As String
Dim sFile As String
Dim sExt As String
Dim sSubject As String

enviro = CStr(Environ("USERPROFILE"))

sSubject = Item.Subject
ReplaceCharsForFileName sSubject, "_"

sName = Item.SenderName
ReplaceCharsForFileName sName, "_"

dtDate = Item.ReceivedTime
sName = Format(dtDate, "ddmmyyyy", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnnss", _
vbUseSystemDayOfWeek, vbUseSystem) & "-" & sSubject & "#####" & sName & ".msg"
' use My Documents in older Windows.
sPath = "c:\mails\"
Debug.Print sPath & sName
Item.SaveAs sPath & sName, olMSG
End Sub

Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub
 
Top