移動郵件的VBA腳本無法處理加密郵件

Question

我有一個VBA腳本，用於將郵件歸檔到個人文件夾。它在正常消息上正常工作，但每次遇到已加密的消息時，都會發出運行時錯誤「底層安全系統無法找到您的數字身份證名稱」。

如何調整我的代碼以便移動加密的消息？

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

VBA代碼無法對加密電子郵件進行任何操作。從VBA你不能真正知道他們是加密的。我見過一些人說有一種S/MIMME類型的附件。您可以在電子郵件中查看。我沒有在我的公司加密中找到。

您也無法使用VBA移動加密的電子郵件。

在我看來，當你有你的objVariant嘗試讀取它的一個簡單的屬性。如果你不能和你得到一個錯誤，然後假設它被加密。

Answer 2

這是我在Outlook 2007中用於在我的工具欄上實現Gmail樣式「存檔」按鈕的代碼。

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 

它需要自行簽名才能工作。這裏是我使用的教程：http://www.howto-outlook.com/howto/selfcert.htm

當它試圖移動一個加密的文件時，它會發出一個警告，說該文件在操作後不再被簽名，但是在點擊「OK」後它仍然成功地完成了操作。