Question

我有一个VBA脚本，用于将邮件存档到个人文件夹。它在正常消息上工作正常，但每次遇到已加密的消息时，它都会产生运行时错误“底层安全系统无法找到您的数字ID名称”。

如何调整我的代码以便移动加密邮件？

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样式的代码＆＃34;存档＆＃34;我的工具栏上的按钮。

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

当它尝试移动加密文件时会发出警告，说明操作后文件将不再签名，但是在点击＆＃34之后;确定＆＃34;它无论如何都成功地完成了行动。

移动邮件的VBA脚本无法处理加密邮件

2 个答案: