I have written a code which creates the appointment in outlook 2016, but I am stuck here to change the time zone. Can anybody help here thanks in advance.
Sub Outlook_Appointment()
Dim o As Outlook.Application
Set o = New Outlook.Application
Dim ONS As Outlook.Namespace
Set ONS = o.GetNamespace("MAPI")
Dim CAL_FOL As Outlook.Folder
Set CAL_FOL = ONS.GetDefaultFolder(olFolderCalendar)
Dim myapt As Outlook.AppointmentItem
Set myapt = CAL_FOL.Items.Add(olAppointmentItem)
With myapt
.Display
.Start = Date + TimeValue("15:30:00")
.End = Date + TimeValue("16:30:00")
.Location = "Seattle"
.Subject = "Discussion"
.Body = "This is a test mail to block the calendar"
.ReminderMinutesBeforeStart = TimeValue("00:15:00")
.To = "abc#gmail.com"
.Save
End With
End Sub
Thanks
The AppointmentItem.Start property value is always represented in the local time zone, check out Application.TimeZones.CurrentTimeZone which returns a TimeZone value that represents the current Windows system local time zone.
The time zone information is used to map the appointment to the correct UTC time when the appointment is saved, and into the correct local time when the item is displayed in the calendar.
The AppointmentItem.StartTimeZone property returns or sets a TimeZone value that corresponds to the time zone for the start time of the appointment.
The AppointmentItem.EndInEndTimeZone property returns or sets a Date value that represents the end date and time of the appointment expressed in the AppointmentItem.EndTimeZone.
Related
I want to create Visual Basic scrip to create calendar event/invitation.
Script is working perfectly, when only one account is registered in outlook, and event is created OK for this single calendar (account).
PROBLEM:
I have two accounts registered in my outlook. One of the accounts is company-managed (let's call it FIRST). I have also manually created account (let's call it SECOND).
The problem is when I want to create event "on behalf" of SECOND calendar registered manually. I've already set SECOND account as primary account in outlook with:
Outlook->File->Account Settings->Account Setting...->Email Tab->Set as default.
When I'm using (almost) identical code as below to create Outlook email object, script is working perfectly fine, and field "Sender" in the message is populated with correct SECOND account name.
Picture: Email outlook object created, with SENDER populated with correct SECOND account
I've tried to set property: objAppointmentItem.SendUsingAccount = myAccount , with the SECOND account, but then Sender field is left empty, and you can't select account from combo. When I'm sending it it ANYWAY, then it is send to correct recipients, but is NOT send to my SECOND calendar (desired), and invitation/event is visible in my FIRST calendar, which I DON'T want to use anymore.
Picture: Outlook event object with FROM field empty, no selection possible
When I'm NOT setting property: objAppointmentItem.SendUsingAccount = myAccount , event object is created, but is assigned with FIRST account, despite SECOND is set as default.
Picture: Event created with wrong sender, and NO SELECTION possible for SECOND account
When I create invitation with double-click on calendar itself (SECOND account calendar), then invitation is created with correct SECOND account populated in SENDER field, (still no option to select other account - but no need, as is correct :) )
Sub OutOfOfficeEvent()
Dim oAccount As Outlook.Account
Dim myAccount As Outlook.Account
'try to find PERSONAL account. If failed, then send with last avail on the list Application.Session.Accounts
For Each oAccount In Application.Session.Accounts
Set myAccount = oAccount
If InStr(UCase(oAccount.DisplayName), "PERSONAL.COM") Then
Exit For
End If
Next
Dim objOutlookApplication As Outlook.Application
Dim objAppointmentItem As Outlook.AppointmentItem
Dim objRecipient As Recipient
Dim objRecipients As Recipients
Set objOutlookApplication = CreateObject("Outlook.Application")
Set objAppointmentItem = objOutlookApplication.CreateItem(olAppointmentItem)
'###############################################
'####### NOT working for event/invitation
'####### Working OK for email object creation
'###############################################
objAppointmentItem.SendUsingAccount = myAccount
'###############################################
objAppointmentItem.Display
Set objRecipients = objAppointmentItem.Recipients
Set objRecipient = objAppointmentItem.Recipients.Add("somebody1#PERSONAL.COM")
Set objRecipient = objAppointmentItem.Recipients.Add("somebody2#PERSONAL.COM")
objRecipient.Type = olRequired
For Each objRecipient In objAppointmentItem.Recipients
objRecipient.Resolve
Next
Dim DateStart As Date
Dim DateEnd As Date
DateStart = DateTime.DateAdd("d", 0, DateTime.DateAdd("h", 1, DateTime.DateAdd("s", -Second(Now()), DateTime.DateAdd("n", -Minute(Now()), Now()))))
DateEnd = DateTime.DateAdd("h", 1, DateStart)
With objAppointmentItem
.MeetingStatus = olMeeting
.Subject = "[OOO] " & strUser
.Start = DateStart
.End = DateEnd
.AllDayEvent = False
.ReminderSet = False
.BusyStatus = olFree
.ResponseRequested = False
.Location = ""
.Body = "Some body content"
End With
objAppointmentItem.Display
Set objOutlookApplication = Nothing
End Sub
There are several ways of creating new items in Outlook. See How To: Create a new Outlook Appointment item for more information.
If you have two accounts configured in Outlook you need to get the right calendar folder and then add a new calendar entry there. To get this done you can use the GetDefaultFolder method of the Store class which returns a Folder object that represents the default folder in the store and that is of the type specified by the FolderType argument. This method is similar to the GetDefaultFolder method of the NameSpace object. The difference is that this method gets the default folder on the delivery store that is associated with the account, whereas NameSpace.GetDefaultFolder returns the default folder on the default store for the current profile. So, you may get the right store and add the new calendar entry.
The NameSpace.Stores property returns a Stores collection object that represents all the Store objects in the current profile.
Sub EnumerateFoldersInStores()
Dim colStores As Outlook.Stores
Dim oStore As Outlook.Store
Dim oCalendar As Outlook.Folder
On Error Resume Next
Set colStores = Application.Session.Stores
For Each oStore In colStores
Set oCalendar = oStore.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar)
Debug.Print (oCalendar.FolderPath)
Next
End Sub
I had the same problem and with above suggestion and some more Google, I found the total solution:
Dim myAI As Outlook.AppointmentItem
myAI = Nothing
Dim oStore As Outlook.Store
For Each oStore In colStores
Dim oCalendar As Outlook.Folder
Set oCalendar = oStore.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderCalendar)
If LCase(oCalendar.Description) = "<accountname>" Then
Set myAI = oCalendar.Items.Add(Outlook.OlItemType.olAppointmentItem)
Exit For
End If
Next
I'm trying to add an appointment to the user's Outlook calendar, set for a specific time in Sydney. But I can't figure out the classes to set the start/end time zone for the AppointmentItem. Here's what I've got:
Dim TempApp As New Outlook.Application()
Dim TempAppItem As Outlook.AppointmentItem = TempApp.CreateItem(Outlook.OlItemType.olAppointmentItem)
TempAppItem.Subject = "Perform reminder action"
TempAppItem.Body = "Reminder to perform"
TempAppItem.Location = "No Location"
TempAppItem.Start = Convert.ToDateTime("22/11/2021 04:00:00 PM")
TempAppItem.End = Convert.ToDateTime("22/11/2021 05:00:00 PM")
TempAppItem.StartTimeZone = **missing solution here**("AUS Eastern Standard Time")
TempAppItem.EndTimeZone = **missing solution here**("AUS Eastern Standard Time")
TempAppItem.ReminderSet = True
TempAppItem.ReminderMinutesBeforeStart = 0
TempAppItem.BusyStatus = Outlook.OlBusyStatus.olBusy
TempAppItem.IsOnlineMeeting = False
TempAppItem.Save()
TempApp = Nothing
TempAppItem = Nothing
Of course I figure it out IMMEDIATELY after posting the question (following searching for an hour). Here it is:
Dim tzs As Outlook.TimeZone = TempApp.TimeZones("AUS Eastern Standard Time")
TempAppItem.StartTimeZone = tzs
TempAppItem.EndTimeZone = tzs
I wrote a script to get my own sent email list. It worked until recently.
It works for 2021/07 or older months but but it cannot get any of 2021/08 emails.
I suppose it's caused by some cache reason (maybe some of the emails don't exist in local folders yet).
Sub get_Sent_mail()
On Error Resume Next
Dim olApp As Outlook.Application
Dim nmsName As NameSpace
Dim mail As mailitem
Dim text1 As String
sent_month = "2021/8"
Set olApp = Outlook.Application
Set nmsName = olApp.GetNamespace("MAPI")
For Each mail In nmsName.Folders("abc#efd.com").Folders("inbox").Folders("Sent Emails").Items
If InStr(mail.ReceivedTime, sent_month) <> 0 Then
Debug.Print mail.subject
End If
Next
End Sub
You are relying on the local settings to convert a datetime value mail.ReceivedTime to a string. That string might contain the month name instead of the number or a number with a without a leading 0. Or the year/month sequence can be different (m/y vs y/m)
You need to explicitly retrieve the month and year number and treat them as integers
If (Month(mail.ReceivedTime) = 8) AND (Year(mail.ReceivedTime) = 2021) Then
Debug.Print mail.subject
End If
Worse than that, your code is extremely inefficient - it is like writing a SQL query without a WHERE clause. You really need to use Items.Restrict:
set items = nmsName.Folders("abc#efd.com").Folders("inbox").Folders("Sent Emails").Items
set restrictedItems = items.Restrict("[ReceivedTime] >= '2021/08/01' AND [ReceivedTime] < '2021/09/01'")
for each mail in restrictedItems
Debug.Print mail.subject
next
We use the following code to create a number of items in a shared calendar. Everything works out, only the invites are not send to the optional attendees. Unfortunately the MS Docs are a bit unclear in this area:
Sub DoOne(Calendar, Subject, Start, Duration, Category)
Dim Appointment As Outlook.AppointmentItem
Dim Attendee As Outlook.Recipient
If Subject <> "" Then
Set Appointment = Calendar.Items.Add
With Appointment
.Start = Start
.Duration = Duration
.ReminderSet = False
.Subject = Subject
.Categories = Category
Set Attendee = Appointment.Recipients.Add("distrubutionlist")
Attendee.Type = olOptional
Appointment.Move Calendar
Appointment.Send
End If
End Sub
Also tried this with the property OptionalAttendees.Add but also there no invites are generated.
You must set the meeting status for the appointment first by using the AppointmentItem.MeetingStatus property which sets an OlMeetingStatus constant specifying the meeting status of the appointment.
Sub CreateAppt()
Dim myItem As Object
Dim myRequiredAttendee, myOptionalAttendee, myResourceAttendee As Outlook.Recipient
Set myItem = Application.CreateItem(olAppointmentItem)
myItem.MeetingStatus = olMeeting
myItem.Subject = "Strategy Meeting"
myItem.Location = "Conference Room B"
myItem.Start = #9/24/2020 1:30:00 PM#
myItem.Duration = 90
Set myRequiredAttendee = myItem.Recipients.Add("Eugene Astafiev")
myRequiredAttendee.Type = olRequired
Set myOptionalAttendee = myItem.Recipients.Add("Kevin Kennedy")
myOptionalAttendee.Type = olOptional
Set myResourceAttendee = myItem.Recipients.Add("Conference Room B")
myResourceAttendee.Type = olResource
myItem.Display
End Sub
Also, you need to pay special attention to the Move method which is called right before the Send one. It moves a Microsoft Outlook item to a new folder and returns an Object value that represents the item that has been moved to the designated folder. So, your code shouldn't call the Move method or handle it gracefully:
movedItem = Appointment.Move Calendar
movedItem.Send
With these two changes worked, thanks, Eugene.
The working code reads:
Sub DoOne(Calendar, Subject, Start, Duration, Category)
Dim Appointment As Outlook.AppointmentItem
Dim Attendee As Outlook.Recipient
If Subject <> "" Then
Set Appointment = Calendar.Items.Add
With Appointment
.MeetingStatus = olMeeting
.Start = Start
.Duration = Duration
.ReminderSet = False
.Subject = Subject
.Categories = Category
End With
Set Attendee = Appointment.Recipients.Add("distributionlist")
Attendee.Type = olOptional
Attendee.Resolve
Appointment.Send
End If
End Sub
Using VBA, I need to show the start date of each INSTANCE of a recurring appointment in Outlook.
The problem is that when I use appt.start it shows the start date of the SERIES, which is not helpful!!
Example: a recurring appointment happens on the first of every month in 2009.
I want to show 12 INSTANCES, with 12 DIFFERENT start dates (1/1/09, 2/1/09, etc).
In other words, all 12 should NOT show start date = 1/1/09.
Thanks
A date restriction will pick up instances of a recurring appointment that occur between the dates specified BUT when you interrogate the properties of the instance - for example .IsRecurring or .AllDayEvent, Outlook redirects the pointer towards the first recurring appointment (the parent as it were). The way round this is to examine the start and end date (copy to local variables) before you lose them by examining other properties.
Dim olNS As Outlook.Namespace
Dim olRec As Outlook.Recipient
Dim myCalItems As Outlook.Items
Dim strRestriction As String
Dim ItemstoCheck As Outlook.Items
Dim MyItem As Outlook.AppointmentItem
Dim datAppStart As Date
Dim datAppEnd As Date
Set myCalItems = olNS.GetSharedDefaultFolder(olRec, olFolderCalendar).Items
' Including recurrent appointments requires sorting by the Start property, apparently!
myCalItems.Sort "[Start]", False
myCalItems.IncludeRecurrences = True
strRestriction = "[Start]<= " & Quote(datEndDate & " 12:00 AM") & " AND [End] >= " & _
Quote(datStartDate & " 11:59 PM")
Set ItemstoCheck = myCalItems.Restrict(strRestriction)
For Each MyItem In ItemstoCheck
If MyItem.Class = olAppointment Then
'Save Start and end dates in case replaced by first instance of recurring appointment
datAppStart = MyItem.Start
datAppEnd = MyItem.End
etc.