CODEWITHSUNDEEP
vbaoutlookoutlook-2007
Tim
Tim

Reputation: 41

VBA script that moves messages can't handle encrypted messages

I have a VBA script that I use to archive messages to a personal folder. It works fine on normal messages but I every time it encounters a message that has been encrypted it kicks out an run-time error "Your Digital ID name cannot be found by the underlying security system".

How can I tweak my code so that it will move encrypted messages?

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

Upvotes: 4

Views: 2988

Answers (2)

John K
John K

Reputation: 506

This is the code I use in Outlook 2007 to implement a Gmail style "Archive" button on my tool bar.

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

It needs to be self signed to work. Here is the tutorial I used: http://www.howto-outlook.com/howto/selfcert.htm

When it tries to move an encrypted file it gives a warning saying that the file will no longer be signed after the operation, but after clicking "OK" it successfully completes the action anyway.

Upvotes: 0

darbid
darbid

Reputation: 2721

It is impossible from VBA code to do anything with encrypted emails. From VBA you cannot really tell they are encrypted. I have seen some people say that there is a certain attachment which is of a S/MIMME type. You can check that out on your emails. I did not find that in my company encryption.

You also cannot move an encrypted email with VBA.

In my opinion when you have your objVariant try to read a simple property of it. If you cannot and you get an error then assume it is encrypted.

Upvotes: 2

Related Questions