Macro VB pour courriel

Bonjour à toutes et à tous.

J'ai une macro pour sauvegarder des courriels

Je voudrais ajouter sender name et remplacer ensuite par ses initiales

SenderName qui s’ajoute dans le titre du message et

J’y ajouterait un Replace : Si Eric tremblay replace by ET Etc.

Voici le code

Option Explicit
Public Sub SaveMessageWithDate()
Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String

sPath = BrowseForFolder("C:\Users\username\documents\")

enviro = CStr(Environ("USERPROFILE"))
For Each objItem In ActiveExplorer.Selection
If objItem.MessageClass = "IPM.Note" Then
Set oMail = objItem

sName = oMail.Subject
ReplaceCharsForFileName sName, "-"

dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & Format(dtDate, "_hh:nn", _
vbUseSystem) & " - " & sName & ".msg"

Debug.Print sPath & sName
oMail.SaveAs sPath & sName, olMsg

End If
Next

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, ":", 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, "EXTERNAL", sChr)
sName = Replace(sName, "--", sChr)
sName = Replace(sName, "  ", sChr)
End Sub

MErci de votre support.