Sauvegarde de la boîte de réception en .pst

and.infini Messages postés 1 Date d'inscription mardi 14 août 2018 Statut Membre Dernière intervention 14 août 2018 - 14 août 2018 à 13:12
jordane45 Messages postés 37851 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 1 décembre 2023 - 15 août 2018 à 07:40
Bonjour,

Actuellement, je suis sur un nouveau challenge en développant un code VBA Outlook.
J'aimerai vous demandez quels sont les lignes de codes pour effectuer la tâche en objet (Sauvegarde de la boîte de réception en .pst) s'il vous plaît ?

En vous remerciant par avance pour vos commentaires.

Cordialement,

Ando Rakotomalala

1 réponse

jordane45 Messages postés 37851 Date d'inscription mercredi 22 octobre 2003 Statut Modérateur Dernière intervention 1 décembre 2023 343
Modifié le 15 août 2018 à 07:42
Bonjour,

Bien que nous ne soyons pas là pour remplacer ton moteur de recherches ... (habituellement j'aurai sûrement supprimé ton message....) j'ai quand même décidé de t'aider un peu

Une brève recherche sur le net ( environ....oula... 10 longues secondes... et encore... j'ai pris mon temps.....) m'a permis de trouver ce code ( dans ce lien http://www.vbaexpress.com/forum/showthread.php?52361-Outlook-Automate-Export-to-file-%28-PST%29= )
Option Explicit

Sub BackUpEmailInPST()
Dim olNS As Outlook.NameSpace
Dim olBackup As Outlook.Folder
Dim bFound As Boolean
Dim strPath As String
Dim strDisplayName As String
    strDisplayName = "Backup " & Format(Date, "yyyymmdd")
    strPath = "C:\Path\" & strDisplayName & ".pst"
    Set olNS = GetNamespace("MAPI")
    olNS.AddStore strPath
    Set olBackup = olNS.folders.GetLast
    olBackup.Name = strDisplayName
    RunBackup olNS, olBackup
    olNS.RemoveStore olBackup
lbl_Exit:
    Set olNS = Nothing
    Set olBackup = Nothing
    Exit Sub
End Sub

Sub RunBackup(olNS As Outlook.NameSpace, olBackup As Outlook.Folder)
Dim oFrm As New frmSelectAccount
Dim strAcc As String
Dim olStore As Store
Dim olFolder As Folder
Dim i As Long
    With oFrm
        .BackColor = RGB(191, 219, 255)
        .Height = 190
        .Width = 240
        .Caption = "Backup E-Mail"
        With .CommandButton1
            .Caption = "Next"
            .Height = 24
            .Width = 72
            .Top = 126
            .Left = 132
        End With
        With .CommandButton2
            .Caption = "Quit"
            .Height = 24
            .Width = 72
            .Top = 126
            .Left = 24
        End With

        With .ListBox1
            .Height = 72
            .Width = 180
            .Left = 24
            .Top = 42
            For Each olStore In olNS.Stores
                If Not olStore.DisplayName = olBackup Then
                    .AddItem olStore
                End If
            Next olStore
        End With
        With .Label1
            .BackColor = RGB(191, 219, 255)
            .Height = 24
            .Left = 24
            .Width = 174
            .Top = 6
            .Font.Size = 10
            .Caption = "Select e-mail store to backup"
            .TextAlign = fmTextAlignCenter
        End With
        .Show
        If .Tag = 0 Then GoTo lbl_Exit
        With oFrm.ListBox1
            For i = 0 To .ListCount - 1
                If .Selected(i) Then
                    strAcc = .List(i)
                    Exit For
                End If
            Next i
        End With
        Set olFolder = olNS.Stores(strAcc).GetDefaultFolder(olFolderInbox)
        olFolder.CopyTo olBackup
        DoEvents
        Set olFolder = olNS.Stores(strAcc).GetDefaultFolder(olFolderSentMail)
        olFolder.CopyTo olBackup
    End With
lbl_Exit:
    Unload oFrm
    Set olStore = Nothing
    Set olFolder = Nothing
    Exit Sub
End Sub


Tu trouveras dans le lien, le userform qu'il a utilisé pour son code.

Même si ça ne fait pas exactement ce que tu souhaites... tu as là les lignes de codes principales à utiliser pour effectuer la sauvegarde que tu souhaites.
Ne te reste plus qu'à l'adapter à ton besoin.
J'espère que ça répondra à ta question.

Cordialement, 
Jordane                                                                 
0
Rejoignez-nous