VBA для Outlook - получение желаемых результатов после того, как объект перемещается

Резюме

Я пытаюсь программно добавить гиперссылки на задачи, созданные из писем, которые я переместил в другую папку. Цель состоит в том, чтобы задача содержала гиперссылку, связывающую с элементом outlook, который был перемещен в папку "обработанная электронная почта", но у меня возникли некоторые проблемы. Что бы быть лучший способ, чтобы получить идентификатор записи объекта после переезда?

Задача

Однако я не понимаю, как переместить MailItem, а затем программно получить его новый EntryID после того, как он движется. "Наивный" способ не работает. После использования метода Move для перемещения объекта MailItem свойство EntryID не отражает изменения идентификатора.

Подробности

Создать гиперссылку на элемент Outlook в формате outlook:<EntryID> достаточно просто, если элемент outlook остается в папке Входящие, так как я могу просто получить EntryID объекта, на который я ссылаюсь. Однако Outlook изменяет идентификатор EntryID при перемещении объекта. Я хочу понять, как получить обновленный идентификатор, поэтому что я могу построить точную связь.

Пример

См. следующий пример кода. Окна сообщений показывают, что свойство EntryID objMail по-прежнему возвращает то же значение, несмотря на то, что объект перемещается. Однако запуск отдельного макроса для почты в папке назначения подтверждает, что идентификатор EntryID изменился при перемещении. 

Sub MoveObject(objItem As Object)

Select Case objItem.Class
Case olMail

    Dim objMail As MailItem
    Set objMail = objItem

    MsgBox (objMail.EntryID)

    Dim inBox As Outlook.MAPIFolder
    Set inBox = Application.ActiveExplorer().Session.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderInbox)
    Dim destFolder As Outlook.MAPIFolder
    Set destFolder = inBox.Folders("Processed Email")
    If (Application.ActiveExplorer().CurrentFolder.Name <> destFolder.Name) Then 
        objMail.Move destFolder
    End If
    MsgBox (objMail.EntryID)
End Select
End Sub

Заранее спасибо за вашу помощь!

2 3
vba

2 ответа:

МетодMove класса MailItem возвращает объект, представляющий элемент, который был перемещен в указанную папку. Вам нужно проверить значение EntryID возвращаемого объекта, а не исходного.

В любом случае, вы можете рассмотреть возможность обработки событияItemAdd целевой папки, чтобы убедиться, что обновленное значение идентификатора записи используется все время.

 Sub MoveItems() 
  Dim myNameSpace As Outlook.NameSpace 
  Dim myInbox As Outlook.Folder 
  Dim myDestFolder As Outlook.Folder 
  Dim myItems As Outlook.Items 
  Dim myItem As Object  
  Set myNameSpace = Application.GetNamespace("MAPI") 
  Set myInbox = myNameSpace.GetDefaultFolder(olFolderInbox) 
  Set myItems = myInbox.Items 
  Set myDestFolder = myInbox.Folders("Personal Mail") 
  Set myItem = myItems.Find("[SenderName] = 'Eugene Astafiev'") 
  While TypeName(myItem) <> "Nothing" 
   myItem.Move myDestFolder 
   Set myItem = myItems.FindNext 
  Wend 
 End Sub
4

Здравствуйте, не могли бы Вы уточнить свой ответ, я не в состоянии Его понять.

В любом случае, вы можете рассмотреть возможность обработки события ItemAdd целевой папки, чтобы убедиться, что обновленное значение идентификатора записи используется все время.

Вот мой код, и мне нужно EntryID после перемещения.

Sub Movetest1()


    Dim olApp As Outlook.Application
    Dim olns As Outlook.NameSpace


    Dim Fld As Folder
    Dim ofSubO As Outlook.MAPIFolder
    Dim myDestFolder As Outlook.Folder
    Dim ofolders As Outlook.Folders


    Dim objItems As Outlook.Items



    Dim myRestrictItems As Outlook.Items
    Dim i As Long


    Dim myitem As Object

'    Dim MailItem As Microsoft.Office.Interop.Outlook.MailItem

    Dim MailItem, moveditem As Outlook.MailItem




    Dim eid As String
    Dim sid As Variant
    Dim newEID As String


'---------------------------------------------------------------------------------------------------------


    Set olApp = New Outlook.Application
    Set olns = olApp.GetNamespace("MAPI")


    For Each Fld In olns.Folders
        If Fld.Name = "GSS Payables" Then

'
'            MsgBox Fld.Name
'            Debug.Print " - "; Fld.EntryID

            Set Fld = olns.GetFolderFromID("000000009DA6D76FBE7A58489450CDF6094F592A0100A2457DC435B22448A832DB721D8185B1000000B6207D0000").Folders("Inbox")
            Exit For
        End If
      Next



Set objItems = Fld.Items


eid = "000000009DA6D76FBE7A58489450CDF6094F592A0700A2457DC435B22448A832DB721D8185B1000000B620800000A2457DC435B22448A832DB721D8185B100007FF773270000"
sid = "000000009DA6D76FBE7A58489450CDF6094F592A0100A2457DC435B22448A832DB721D8185B1000000B6207D0000"



Set myDestFolder = Fld.Folders("Bhagyashri")

'Set myitem = objItems.Find("[SenderName]='Microsoft Outlook '")

Set MailItem = olns.GetItemFromID(eid)




Set moveditem = MailItem.Move(myDestFolder)

"giving error here
 newID = moveditem.entryid




Debug.Print "newID -"; newID



' get mailitem.parent.storeid

MsgBox "done"


End
1