Outlook 2003 / VBA Movin E-Mail без изменения даты

Question

Я использую макрос в 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

Это работает, когда я нахожусь в папке «Входящие». Кто-нибудь знает, как я могу установить Store-ID в GetMessageFromID на идентификатор магазина, в котором сделан мой выбор?

Редактировать: Спасибо 76mel, сейчас я использую objItem.Parent.StoreID для получения текущего идентификатора StoreID.

Answer 1

Ваше право: в сети появилось несколько сообщений о том, что это не работает.

Может показаться, что VB6 не выдает ошибку :(. Я думаю, что способ решить эту проблему - использовать CDO или стороннюю библиотеку "Redemption", созданную де-факто.

M

Обновление: Попробуйте что-то вроде этого ... У меня нет 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

Answer 2

Я нашел решение: в подпапке, в которую вы перемещаете письмо, просто добавьте столбец для поля «дата создания» вместо «дата получения» и выполните сортировку, используя это поле ... работа выполнена!

Reef

Answer 3

Это не меняет дату для меня в Outlook 2003 также. Если для вас это не решается, я постараюсь получить дату элемента и перезаписать его после передачи.