Move sent items emails to hard disk

[rollno]

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) 
 
Dim sName As String 
 
Dim sPath As String 
 
Dim enviro As String 
 
On Error Resume Next 
 
enviro = CStr(Environ("username")) 
 
Const olmsg = 3 
 
ReplaceCharsForFileName sName, "_" 
 
sPath = enviro & "C:\Users\username\Desktop\Sent emails\" 
 
sName = Item.Subject & ".msg" 
 
Debug.Print sPath & sName 
 
Item.SaveAs sPath & sName, olmsg 
 
End Sub 
 
Private Sub ReplaceCharsForFileName(fName 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)
 sName = Replace(sName, "#", sChr)
 sName = Replace(sName, ",", sChr)
 sName = Replace(sName, "||", sChr) 
 
End Sub

Please help this code works fine only if I do not have RE: in the subject line....I am not sure where I am making a mistake...this code could also be wrong or you may find some unnecessary lines in this...Please help...

 

[Forum Admin]

What is the error message if there is a re:?

I'm guessing the problem is the file name is not unique. To avoid problems, add the received time to the file name.

Dim dtDate As Date

Dim sName As String
dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "-hhnnss", _
vbUseSystemDayOfWeek, vbUseSystem) & "-" & sName & ".msg"

The date format is here: "yyyymmdd" and you can add hhmmss if you need to break it down - if you want to use separators, you can use any character that is valid for filenames, most people use - yyyy-mm-dd-hh-mm-ss but i prefer to use one solid number yymmddhhmmss

You could use the saved time instead (use Now instead of receivedtime) or use a random number - i have some macro samples at http://www.poremsky.com/office/sequential-numbers-random-character-keywords/

 

[rollno]

Actually I do nolt want to add the received time to the file name. Can you please help, I have another code as well but it does not work either...if there are no special characters in the subject line then it works fine .

------------------------------------Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

Dim fName As String

Dim i

Const olmsg = 3

illegals = "#,/|\:" ' add any additional characters to the string

temp = Item.Subject

For i = 1 To Len(illegals)

temp = Replace(temp, Mid(illegals, i, 1), "_") ' replace illegal character with nothing

Next

fName = "C:\Users\unknown\Desktop\Sent emails\" & temp

Item.SaveAs fName, olmsg

End Sub

 

[rollno]

Wow my latest code is working now..we can close this thread...thank you all.

 

[Diane Poremsky]

if the problem is special characters, you need to clean the url.

Try this to clean the subject -

temp = Item.Subject
ReplaceCharsForFileName temp, "-"

Repeat each line for the characters that need to be removed -

Private Sub ReplaceCharsForFileName(temp As String, _
sChr As String)
temp = Replace(temp, "#", sChr)
temp = Replace(temp, Chr(34), sChr)

End Sub

http://www.slipstick.com/developer/code-samples/save-selected-message-file/ has a sample with a list of all of the characters.

 

[rollno]

if the problem is special characters, you need to clean the url.

Try this to clean the subject -

temp = Item.Subject
ReplaceCharsForFileName temp, "-"

Repeat each line for the characters that need to be removed -

Private Sub ReplaceCharsForFileName(temp As String, _
sChr As String)
temp = Replace(temp, "#", sChr)
temp = Replace(temp, Chr(34), sChr)

End Sub

http://www.slipstick.com/developer/code-samples/save-selected-message-file/ has a sample with a list of all of the characters.

Hi the lastest above code posted by me works...but it saves the email before it is sent...can it be modified so it can be copied after it is sent?

 

[Diane Poremsky]

No, the item send macro runs before its sent. If you want to send first, you need to use an itemadd macro to watch the sent folder and save it as it hits the sent folder.

 

[rollno]

No, the item send macro runs before its sent. If you want to send first, you need to use an itemadd macro to watch the sent folder and save it as it hits the sent folder.

Could you please add that code and send it to me, I am really not sure how the coding works...I am searching and doing it on my own..

 

[Diane Poremsky]

See http://www.slipstick.com/outlook/archive-outlook/save-incoming-messages-hard-drive/ - it actually does what you want, except for incoming messages. Change it to olfoldersentitems and fix the filename as necessary.

- - - Updated - - -

See http://www.slipstick.com/outlook/archive-outlook/save-incoming-messages-hard-drive/ - it actually does what you want, except for incoming messages. Change it to olfoldersentitems and fix the filename as necessary.

 

[rollno]

I did not get you?

 

[rollno]

got it thank u so much

- - - Updated - - -

got it thank u so much