Here is some sample code.
Sub CreateCalEntry(LeadDate As Date, DueDate As Date, _
Subject As String, Location As String, _
Body As String, _
Optional AddToShared As Boolean = True)
'Lead date = expect notify from data'
'Due date - expect event due date'
'Add to shared - add item to shared calendar, '
'hard coded as 'Shared Calendar''
Const olApItem = 1
Dim apOL As Object 'Outlook.Application '
Dim oItem As Object 'Outlook.AppointmentItem '
Dim objFolder As Object 'MAPI Folder '
Set apOL = CreateObject("Outlook.Application")
Set objFolder = GetFolder( _
"Public Folders/All Public Folders/Shared Calender")
Set oItem = apOL.CreateItem(olApItem)
With oItem
.Subject = Subject
.Location = Location
.Body = Body
If IsDate(LeadDate) Then
.Start = DueDate
Else
.Start = DueDate
End If
If AddToShared = True Then
.Move objFolder
End If
.Display
End With
Set oItem = Nothing
Set apOL = Nothing
End Sub
Public Function GetFolder(strFolderPath As String) As Object
' strFolderPath needs to be something like '
' "Public Folders\All Public Folders\Company\Sales" or '
' "Personal Folders\Inbox\My Folder" '
'This code is from:
'http://www.outlookcode.com/d/code/getfolder.htm '
Dim apOL As Object 'Outlook.Application '
Dim objNS As Object 'Outlook.NameSpace '
Dim colFolders As Object 'Outlook.Folders '
Dim objFolder As Object 'Outlook.MAPIFolder '
Dim arrFolders() As String
Dim I As Long
strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")
'line for so formatting
Set apOL = CreateObject("Outlook.Application")
Set objNS = apOL.GetNamespace("MAPI")
On Error Resume Next
Set objFolder = objNS.Folders.Item(arrFolders(0))
If Not objFolder Is Nothing Then
For I = 1 To UBound(arrFolders)
Set colFolders = objFolder.Folders
Set objFolder = Nothing
Set objFolder = colFolders.Item(arrFolders(I))
If objFolder Is Nothing Then
Exit For
End If
Next
End If
Set GetFolder = objFolder
Set colFolders = Nothing
Set objNS = Nothing
Set apOL = Nothing
End Function
From: http://wiki.lessthandot.com/index.php/Create_Outlook_Appointment%2C_Shared_Folder