CODEWITHSUNDEEP
exceloutlook
Craig G
Craig G

Reputation: 247

Automatically create Outlook appointments

I have a spreadsheet (excel 2003) which tracks expiration dates, I would like to know if there is a way to have these expiration dates create appointments(reminders) in outlook. The expiration date is in one field and the name of the entity is in another column on the spreadsheet. Ideally I would like outlook (2003) to pick up the date (obviously) and the name of the entity.

Thanks in advance for any help

Upvotes: 4

Views: 23208

Answers (3)

Fionnuala
Fionnuala

Reputation: 91376

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, "\")

    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

Upvotes: 3

ceejayoz
ceejayoz

Reputation: 180176

You could do this via meeting invitations. They wouldn't be automatically accepted, but they'd be there. Meeting invites are just e-mails with special stuff in the headers.

Upvotes: 0

Shoban
Shoban

Reputation: 23016

You can use VBA macros to create out look appointments. Following 2 links will help you get started.

  1. Creating outlook appointment using VBA
  2. Outlookcode

Upvotes: 4

Related Questions