Sauvegarde des messages outlook en fichier txt

Commenter

Contenu du snippet

Ce petit prg permet de sauvegarder tous les messages dans la boite de reception d'Outlook en fichiers TXT indepedants les uns des autres...
Chose qui n'est po possible avec ce joyeux logiciel ;0)

Choses a fiare:
-creer un nouveau projet , normal koi
- composants de projet "Microsoft MAPI control 6.0"
- composants de projet "Microsoft Windows Common Controls 6.0 (SP4)"
- references de projet
-un formulaire, tout pareil
-une drive box nommée "Drive"
-une dir box nommée "Dir"
-une progress bar nommée "ProgressBar"
-un MAPI session nommé "MAPISession"
-un MAPI message nommé "MAPIMessages"
-un bouton nommé "export_messages"
-coller le code !!!

Source / Exemple : 


Private Sub Drive_Change()
    Dir.Path = Drive
End Sub

Private Sub export_messages_Click()
    Dim numfic As Integer
    Dim nomfic As String
    If MsgBox("Voulez vous exporter vos messages dans " & Chr(13) & Dir.Path & " ?", vbYesNo, "Attention") = vbYes Then
    
        'ouverture de session MAPI sur outlook
        MAPISession.SignOn
        'MAPI messages utilise l'ID de la session pour travailler
        MAPIMessages.SessionID = MAPISession.SessionID
        'Recupere les messages 'entrés'
        MAPIMessages.Fetch
        
        'Juste pour savoir ou en on est
        ProgressBar.Visible = True
        ProgressBar.Min = 0
        ProgressBar.Max = MAPIMessages.MsgCount + 1
        
        'Pour tous les messages
        For i = 1 To MAPIMessages.MsgCount - 1
            'Prend un message
            MAPIMessages.MsgIndex = i
            ProgressBar.Value = i
            ProgressBar.Refresh
            'Premier numero de fichier utilisable libre
            numfic = FreeFile
            'Nom de fichier de sortie:
            'Path choisi + compteur de message format 000001 + _ + jour du message
            ' + _ + mois du message + _ + annee du message + 3 premieres lettres du nom expediteur
            ' + .txt Ex: 000001_12_01_2001_tot.txt
            nomfic = Dir.Path & "\" & Format(i, "000000") & "_" & Day(MAPIMessages.MsgDateReceived) & "_" & Month(MAPIMessages.MsgDateReceived) & "_" & Year(MAPIMessages.MsgDateReceived) & "_" & Left(MAPIMessages.MsgOrigDisplayName, 3) & ".txt"
            Open nomfic For Output As numfic
            'On ecrit la date de reception
            Print #numfic, MAPIMessages.MsgDateReceived
            'le nom d origine et l adresse Email
            Print #numfic, MAPIMessages.MsgOrigDisplayName & " " & MAPIMessages.MsgOrigAddress
            'et le texte du message
            Print #numfic, MAPIMessages.MsgNoteText
            Close numfic
        Next i
        'on ferme la session MAPI
        MAPISession.SignOff
        MsgBox "Export terminé.", vbOKOnly, "Fin du traitement"
        ProgressBar.Visible = False
    End If
End Sub

Conclusion :


- Fonctionnement
Choisir un repertoir pour l export a l'aide
de la drive box et de la dir box.
Cliquer sur le bouton export.
La session s'ouvre (ouverture outlook et reception
des derniers meaages)
La progress Bar montre le deroulement restant.

Et voila le travail....

Bonne prog a tous et bravo a Nix

Enjoy ;0))

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.