1

我在 Outlook 2003 中使用宏将选定的电子邮件移动到特定文件夹。移动工作,但不幸的是接收到的日期被覆盖到当前时间。关于如何防止这种情况的任何想法。

我使用这段代码:

Sub verschiebenInOrdner()

On Error Resume Next

    Dim objFolder As Outlook.MAPIFolder, objInbox As Outlook.MAPIFolder
    Dim objNS As Outlook.NameSpace, objItem As Outlook.MailItem

    Set objNS = Application.GetNamespace("MAPI")
    Set objInbox = objNS.GetDefaultFolder(olFolderInbox)

    Set objFolder = objNS.Folders.Item("2009").Folders.Item("In")

    If objFolder Is Nothing Then
        MsgBox "This folder doesn't exist!", vbOKOnly + vbExclamation, "INVALID FOLDER"
    End If

    If Application.ActiveExplorer.Selection.Count = 0 Then
        Exit Sub
    End If

    For Each objItem In Application.ActiveExplorer.Selection
        If objFolder.DefaultItemType = olMailItem Then
            If objItem.Class = olMail Then
                objItem.UnRead = False
                objItem.Move objFolder
            End If
        End If
    Next

    Set objItem = Nothing
    Set objFolder = Nothing
    Set objInbox = Nothing
    Set objNS = Nothing
End Sub

感谢 76mel 的帮助,我想出了这个:

    Sub verschiebenInArchiv()

Dim Session As Redemption.rDOSession
Dim objFolder As Redemption.RDOFolder
Dim objItem As Outlook.MailItem
Dim objItem2 As Redemption.RDOMail

Set Session = CreateObject("Redemption.RDOSession")

Session.Logon

Set objFolder = Session.Stores.Item("2009").IPMRootFolder.Folders("In")

If Application.ActiveExplorer.Selection.Count = 0 Then
    Exit Sub
End If

For Each objItem In Application.ActiveExplorer.Selection
    Set objItem2 = Session.GetMessageFromID(objItem.EntryID, Session.Stores.DefaultStore.EntryID)
    objItem2.Move objFolder
Next

End Sub

当我在收件箱中时,这有效。有谁知道我如何将 GetMessageFromID 中的 Store-ID 设置为进行选择的商店的 ID?

编辑:感谢 76mel,我现在使用 objItem.Parent.StoreID 来获取当前的 StoreID。

4

3 回答 3

1

你的权利,网上有一些报道说它不起作用。

VB6 似乎没有出现错误:(。我认为解决这个问题的方法是使用 CDO 或事实上的 3rd 方库“救赎”。在后台进行实际操作。

更新:试试这样的东西..我可能机器上没有VB,所以没有测试它但你会明白的。

Sub verschiebenInOrdner()

On Error Resume Next


    Dim objNS As Outlook.NameSpace
    Dim objRDOSession As Redemption.RDOSession
    Dim objRDOFolder As Redemption.RDOFolder
    Dim objItem As Outlook.MailItem
    Dim objRDOMail As Redemption.RDOMail


    Set objNS = Application.GetNamespace("MAPI")
    Set objRDOSession = CreateObject("Redemption.RDOSession")
    objRDOSession.MAPIOBJECT = objNS.MAPIOBJECT  'or Logon

    Set objRDOFolder = Session.GetFolderFromPath("<YOUR PATH>")
    ' do your validation for folder and selection



    For Each objItem In Application.ActiveExplorer.Selection
        If objFolder.DefaultItemType = olMailItem Then
            If objItem.Class = olMail Then
              Set objRDOMail = objRDOSession.GetMessageFromID(objItem.EntryID)
              objRDOMail.UnRead = False
              objRDOMail.Move objRDOFolder

            End If
        End If
    Next



    Set objItem = Nothing
    Set objRDOMail = Nothing
    Set objRDOFolder = Nothing
    Set objRDOSession = Nothing
    Set objNS = Nothing
End Sub
于 2009-06-24T15:29:10.643 回答
0

它也不会更改我在 Outlook 2003 中的日期。如果这对您来说是一个持续的问题,我会尝试获取项目的日期并在转移后覆盖它。

于 2009-06-24T00:25:21.713 回答
0

我找到了解决方案:在您将电子邮件移动到的子文件夹中,只需为字段“创建日期”而不是“接收日期”添加一列,然后使用该字段进行排序...完成!

于 2010-02-01T05:02:36.850 回答