2009-09-20

推荐给用G1的朋友

将工作时的日历项自动推送到G1.

Option Explicit

Private WithEvents oCalendarItems As Outlook.Items
Private WithEvents oSentItems As Outlook.Items

Private Sub Application_Startup()
Dim objNS As NameSpace
Set objNS = Application.GetNamespace("MAPI")

'- hook the event to the Calendar folder:
Set oCalendarItems = Session.GetDefaultFolder(olFolderCalendar).Items
'- hook the event to the Sent folder:
Set oSentItems = Session.GetDefaultFolder(olFolderSentMail).Items

Set objNS = Nothing
End Sub

Private Sub oCalendarItems_ItemAdd(ByVal Item As Object)
Dim myolApp As Outlook.Application
Dim oForward As MailItem, strForwardTo As String
Dim newReq As AppointmentItem


'Make sure item is NOT a recurring appointment or provisional
If Item.RecurrenceState = olApptNotRecurring Then
If Item.Subject Like "*provisional*" Or Item.Subject Like "*Provisional*" Or Item.Subject Like "Provisional*" Then
'Do Nothing
Else
'Ensure that the item is an appointment
If TypeName(Item) = "AppointmentItem" Then

Set myolApp = CreateObject("Outlook.Application")
Set newReq = myolApp.CreateItem(olAppointmentItem)


With newReq
.Subject = Item.Subject
.Start = Item.Start
.End = Item.End
.Location = Item.Location
.Body = Item.Body

' make it a meeting request
.MeetingStatus = olMeeting
.RequiredAttendees = "xxxxxxx@gmail.com"
.Send
End With

Set myolApp = Nothing
Set newReq = Nothing
End If
End If

End If
End Sub


' disassociate global objects declared WithEvents
Private Sub Application_Quit()
Set oCalendarItems = Nothing
Set oSentItems = Nothing
End Sub