Note that I put the items in a Calendar in a PST. This is because I needed to be able to easily share what I'd created, and also because I created the script on my live system (so if I'd written a few thousand Calendar items to the Exchange server I might not have been terribly popular if it had caused problems for other users).
The CreateLotsOfApptsInPST needs to be called with the following parameters:
PSTName - the name of the PST; this is the name it shows with in your folder tree (e.g. "Personal Folders") and not the file path. The PST has to be loaded. I didn't test what happens if there's more than one PST loaded with the same name.
Occurences - How many appointments you want to create
Start - The date and time of the first appointment you want to create
Interval - How far apart, in minutes, you want the start times of each appointment, e.g. if you make the Duration 45 mins and the Interval 60 mins, there will be a 15 mins gap between each appointment.
Duration - The duration of each appointment in minutes.
Subject - The subject you want for each appointment. As it is, the script will append a sequential number to each ("Test Appt 1", "Test Appt 2" etc.) but you could easily amend that.
The second sub is called by the first, but you should be able to see what it's doing.
Sub CreateLotsOfApptsInPST(PSTName As String, Occurrences As Long, _
Start As Date, Interval As Integer, Duration As Integer, _
Subject As String)Dim count As Integer
For count = 1 To Occurrences
CreateApptInPST PSTName, Subject & " " & count, _
Start + ((count - 1) * (Interval * (1 / 24 / 60))), Duration
Next countEnd Sub
Sub CreateApptInPST(PSTName As String, Subject As String, _
DateTime As Date, Duration As Integer)Dim olApp As Outlook.Application, objName As NameSpace
Dim PST As MAPIFolder, PSTcal As MAPIFolderSet olApp = Outlook.Application
Set objName = olApp.GetNamespace("MAPI")
Set PST = objName.Folders(PSTName)
Set PSTcal = PST.Folders("Calendar")Dim i As AppointmentItem
Set i = PSTcal.Items.Add
i.Subject = Subject
i.Start = DateTime
i.Duration = Duration
i.SaveEnd Sub
More seasoned coders will give me zero points for style, but it did the job for me!
Nice stuff... I was juss looking for this today. the fact that i can create in any PST file (not just default calendar) is very helpful.
ReplyDeleteI know this post has been here years, but all I was looking for was a way to create an appointment in a particular folder.
ReplyDeleteYour code worked a treat.
Many Thanks
Kristian
This works perfect for my script where I'm trying to add calendar events to tasks automatically. Great job!
ReplyDelete