Sub WriteVcal()
'---------------------------------------------------------------------------------------------
'Description
'===========
'This Excel-module will create an iCal file with names and birthdays in iCal format
'The name will have an "*" in front and as suffix between brackets the age the person will
' reach this birthday
'(Indeed meaning you'll have to run this procedure once a year)
' eg: * JOHN (50)
'
'Instructions
'
' First lets create a .ics file to see what it looks like
'1) enter a Birthday as DayEvent under the Category 'Birthday'
'2) Go to File - Export - Planiing - iCal - Category=Birthday
'3) Open created .ics file with NotePad
'4) Compare and check the settings in the .ics file with the settings below
'
'5) Create an Excel-sheet with Names and Birthday's
'6) Check the columns with the settings below
'7) Open Excels Visual Basic Editor and Insert-Module and copy this file into it
'8) Set cursor within this file and then F5
'
'9) Make a backup/copy of your PIM-file
'10) Import-Planning-iCal into the Birthday category (or whatever your local cat-name is
'
'Settings for Excel
Const XlColName As Integer = 1              'Column with names
Const XLColBirthDate As Integer = 2         'Columns with birthdates
Const XLFirstRowWithNames As Integer = 2
'
'Settings for iCal
Const sLastModified As String = "LAST-MODIFIED:20060605T185709Z"
Const sBirthdayCat As String = "CATEGORIES:Birthday"
Const sTimeAdjust As String = "T220000Z"    'Last 8 chars in DTSTART en DTEND
Const IDateStartOffset As Integer = -1      'Depending on your TimeAdjustment ..
Const iDateEndOffset As Integer = 0         ' the Start or End date may need to be 1 day off
Const iYearToFill As Integer = 0            'We'll fill this year's birthdays by default but you
'                                           ' can enter next year as well
'Settings for the Outputfile
Const sOutputFile As String = "I:\BirthDays.ICS"
'
'---------------------------------------------------------------------------------------------
Dim iRow As Integer
Dim iYearToFill2 As Integer
If iYearToFill = 0 Then
    iYearToFill2 = Year(Now())
Else
    iYearToFill2 = iYearToFill
End If

Open sOutputFile For Output As #1
'
'General First Statement
'
Print #1, "BEGIN:VCALENDAR"
Print #1, "VERSION:2.0"
Print #1, "CALSCALE:GREGORIAN"
Print #1, "METHOD:PUBLISH"
With ActiveSheet
    
    For iRow = XLFirstRowWithNames To 999
        If .Cells(iRow, 1) = "" Then
            Exit For
        End If
        Print #1, "BEGIN:VEVENT"
        Print #1, sLastModified
        Print #1, "DTSTART:" & iYearToFill2 & Format(.Cells(iRow, XLColBirthDate) + IDateStartOffset, "mmdd") & sTimeAdjust
        Print #1, "DTEND:" & iYearToFill2 & Format(.Cells(iRow, XLColBirthDate) + iDateEndOffset, "mmdd") & sTimeAdjust
        Print #1, "SUMMARY:* " & Trim(.Cells(iRow, XlColName)) & " (" & iYearToFill2 - Year(.Cells(iRow, XLColBirthDate)) & ")"
        Print #1, sBirthdayCat
        Print #1, "END:VEVENT"
    Next
End With
Print #1, "END:VCALENDAR"
Close #1
MsgBox "Ready!" & vbCrLf & vbCrLf & iRow - XLFirstRowWithNames & " Birthdays haven been entered in " & sOutputFile & vbCrLf _
    & "You can now import this file using: Import - Planning - iCal" & vbCrLf & vbCrLf _
    & "(And don't forget to make a bakcup of your pim-database first; Entering 100 birthdays is easy " & vbCrLf _
    & "but deleting them again is something different.) " & vbCrLf & vbCrLf _
    & "Have a nice day! Willem Pauw - Netherlands"

End Sub