Переслать как iCal копию любого полученного AppontementItem, удаляющего свойство Organizer (и некоторые другие) - PullRequest
Новая
       35

Переслать как iCal копию любого полученного AppontementItem, удаляющего свойство Organizer (и некоторые другие)

0 голосов
/ 04 июня 2019

Я хочу сохранить в своем личном календаре Google все свои профессиональные встречи (календарь outlok). Это без уведомления организатора о моей личной учетной записи электронной почты. Для этого я определил правило outlook, которое выполняет «сценарий пересылки VBA» при каждом приеме приложения.

Сценарий VBA: 

1. Just extracts the appontement from the received email,
2. Copies it,
3. Modifies some properties (mainly erase some potentially confidencial information, such as attachments, attendees, body, ...),
4. Saves as iCal (which seems necessary to avoid forward warning to the organizer),
5. Attach to a new email addressed to my personal account.

Пока все хорошо, пока gmail не изменил способ обработки входящих сообщений (но это уже другая история).

Теперь похоже, что свойство "организатор" тоже нужно стереть (в противном случае, чтобы сохранить собрание в Google, я должен ответить организатору из своего личного аккаунта, что нежелательно). Но «Организатор» доступен только для чтения.

Я попытался создать новый элемент назначения и скопировать некоторые свойства из исходного ... например, все свойства, кроме организатора. Концепция, кажется, работает (просто копируя некоторые свойства одно за другим), но как перебрать все свойства (чтобы не пропустить важную информацию)?

Я попробовал следующее, но ничего не происходит ... 

Sub Meeting2Newmail(Item As Outlook.MeetingItem)

Dim Item2 As AppointmentItem
Dim ItemTMP As AppointmentItem
Dim olkMsg As MailItem

Const TEMPFILE As String = "C:\Users\D24676\Documents\Reunion.ics"

Set Item2 = Application.CreateItem(olAppointmentItem)
Set ItemTMP = Item.GetAssociatedAppointment(True).Copy


For i = 0 To ItemTMP.ItemProperties.Count - 1
    If Not (ItemTMP.ItemProperties(i).Name = "Organizer") Then
            Item2.ItemProperties(i) = ItemTMP.ItemProperties(i)
    End If
Next

Item2.Body = "Work Meeting"
Item2.OptionalAttendees = ""
Item2.RequiredAttendees = ""
Item2.Body = "Work Meeting"


'I also tried with some manual copies instead of iteration but something is wrong with times...

'Item2.AllDayEvent = ItemTMP.AllDayEvent
'Item2.Duration = ItemTMP.Duration
'Item2.End = ItemTMP.End
'Item2.EndInEndTimeZone = ItemTMP.EndInEndTimeZone
'Item2.EndUTC = ItemTMP.EndUTC
'Item2.Start = ItemTMP.Start
'Item2.StartUTC = ItemTMP.StartUTC
'Item2.StartInStartTimeZone = ItemTMP.StartInStartTimeZone
'Item2.Location = ItemTMP.Location
'Item2.Subject = ItemTMP.Subject

Item2.SaveAs TEMPFILE, olICal
Set olkMsg = Application.CreateItem(olMailItem)
With olkMsg
        'Attach the iCal item
        .Attachments.Add TEMPFILE
        .Subject = ItemTMP.Subject
        .Recipients.Add "personal.address@gmail.com"
        .Body = "Content deleted"
        .Send
End With
Kill TEMPFILE
Item2.Delete
ItemTMP.Delete

End Sub

Спасибо за помощь!

...