Script VBA qui déplace les messages ne peut pas gérer les messages cryptés

Question

J'ai un script VBA que j'utilise pour archiver des messages dans un dossier personnel. Cela fonctionne bien sur les messages normaux mais chaque fois qu'il rencontre un message qui a été chiffré, il génère une erreur d'exécution "Votre nom d'identification numérique ne peut pas être trouvé par le système de sécurité sous-jacent".

Comment puis-je modifier mon code afin qu'il déplace les messages cryptés?

Public Sub MoveToArchive() 

Dim objOutlook As Outlook.Application 
Dim objSourceNamespace As Outlook.NameSpace 
Dim objDestNamespace As Outlook.NameSpace 
Dim objSourceFolder As Outlook.MAPIFolder 
Dim objDestFolder As Outlook.MAPIFolder 
Dim objVariant As Variant 
Dim lngMovedMailItems As Long 
Dim intCount As Integer 
Dim strDestFolder As String 

' Create an object for the Outlook application. 
Set objOutlook = Application 
' Retrieve an object for the MAPI namespace. 
Set objSourceNamespace = objOutlook.GetNamespace("MAPI") 
Set objDestNamespace = objOutlook.GetNamespace("MAPI") 

' Retrieve a folder object for the source folder. 
Set objSourceFolder = objSourceNamespace.Folders("Mailbox - Me").Folders("Deleted Items") 
Set objDestFolder = objDestNamespace.Folders("Archive - Current Year").Folders("Deleted Items") 

' Loop through the items in the folder. NOTE: This has to 
' be done backwards; if you process forwards you have to 
' re-run the macro an inverese exponential number of times. 
For intCount = objSourceFolder.Items.Count To 1 Step -1 
    ' Retrieve an object from the folder. 
    'Debug.Print objSourceFolder.Items.Item(intCount) 
    Set objVariant = objSourceFolder.Items.Item(intCount) 
    ' Allow the system to process. (Helps you to cancel the 
    ' macro, or continue to use Outlook in the background.) 
    DoEvents 
    ' Filter objects for emails or meeting requests. 
    If objVariant.Class = olMail Or objVariant.Class = olMeetingRequest Then 
     ' This is optional, but it helps me to see in the 
     ' debug window where the macro is currently at. 
     ' Debug.Print objVariant.SentOn 

     ' Move the object to the destination folder. 
     objVariant.Move objDestFolder 
     ' Just for curiousity, I like to see the number 
     ' of items that were moved when the macro completes. 
     lngMovedMailItems = lngMovedMailItems + 1 

    End If 
Next 

' Display the number of items that were moved. 
' MsgBox "Moved " & lngMovedMailItems & " messages(s)." 

End Sub 

Answer 1

Il est impossible à partir du code VBA de faire quoi que ce soit avec des courriels cryptés. De VBA vous ne pouvez pas vraiment dire qu'ils sont cryptés. J'ai vu certaines personnes dire qu'il y a une certaine pièce jointe qui est de type S/MIMME. Vous pouvez vérifier cela sur vos emails. Je n'ai pas trouvé cela dans le cryptage de mon entreprise.

Vous ne pouvez pas non plus déplacer un e-mail crypté avec VBA. À mon avis, lorsque vous avez votre objVariant essayer de lire une simple propriété de celui-ci. Si vous ne pouvez pas et vous obtenez une erreur, supposez qu'il est crypté.

Answer 2

C'est le code que j'utilise dans Outlook 2007 pour implémenter un bouton "Archive" de style Gmail dans ma barre d'outils.

Sub Archive() 
    Set ArchiveFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Parent.Folders("Archive") 
    For Each Msg In ActiveExplorer.Selection 
     If ActiveExplorer.Selection.Parent <> ArchiveFolder Then Msg.Move ArchiveFolder 
    Next Msg 
End Sub 

Il doit être auto-signé pour fonctionner. Lorsqu'il essaie de déplacer un fichier crypté, il indique que le fichier ne sera plus signé après l'opération, mais après avoir cliqué sur "OK", il terminera l'action avec succès.