1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
| Sub mails_format_txt()
Dim oFold As MAPIFolder
'merci à Heureux-oli de developpez.net qui m'a aider pour cette petite macro utile
Dim oItem As MailItem
Dim oNS As NameSpace
Dim repert As String
'Répertoire destination
repert = "c:\mes_mails\"
On Error Resume Next
Set oNS = Application.GetNamespace("MAPI")
Set oFold = oNS.PickFolder
'variable nom du sujet
Dim NomExport As String
'variable pour le nom du sujet qui sera nettoyé
Dim titre As String
'variable d'incrémentation pour un nom unique
Dim n As Integer
'On la démarre de 1
n = 1
'boucle pour l'exporattion des messages et enregistrement au format txt
For Each oItem In oFold.Items
'Le titre original
NomExport = oItem.subject
'le titre nettoyé commençant par txt
titre = "txt" & Left(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(NomExport, "\", ""), "/", ""), ":", ""), "*", ""), "?", ""), "<", ""), ">", ""), "|", ""), ".", ""), """", ""), vbTab, ""), Chr(7), ""), 160)
'enregistrement
oItem.SaveAs repert & titre & n & ".txt", olTXT
'incrémentation
n = n + 1
Next oItem
End Sub |
Partager