Moving emails to another folder outside of outlook

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I'm trying to find vb script that will move my emails from the inbox over to
a local c: drive folder. Help a new code writer please.
 
Am Fri, 4 Aug 2006 21:44:01 -0700 schrieb CodeWriter:

This sample saves all e-mails from the Inbox and then deletes them.

Public Sub SaveAllMailsAsFile()
Dim obj As Object
Dim oItems As Outlook.Items
Dim i as Long

Set oItems = Application.Session.GetDefaultFolder(olFolderInbox).Items
For i= oItems.Count to 1 Step-1
Set obj=oItems(i)
If TypeOf obj Is Outlook.MailItem Then
SaveMailAsFile obj, "c:\"
obj.Delete
End If
Next
End Sub

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

sExt=".msg"

' Remove invalid file name characters
sName = oMail.Subject
ReplaceCharsForFileName sName, "_"

' Build file name from subject and received date
dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbMonday, vbFirstJan1) _
& Format(dtDate, "-hhnnss", vbMonday, vbFirstJan1) _
& "-" & 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
 
Back
Top