将删除了Organizer属性(和其他一些属性)的所有收到的AppontementItem的副本作为iCal转发

时间:2019-06-04 10:11:53

标签: outlook-vba

我想在我的个人Google日历上保存我的所有专业会议(外出日历)。无需让组织者知道我的个人电子邮件帐户。 为此,我定义了一个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

感谢帮助!

0 个答案:

没有答案