Code to export calendar appointments with link to SQL Server for field substitution

I have a public calendar in Exchange 2003.
I want to export as .ics files and modify the Subject: and possibly the description and filter by type
and rename the output filename with part of the description field.
These files will reside on a web server and when customers wish to have an entry placed in their outlook calendar there will be a link on the product page fromm our web site to this file.

As the entries are  processed there may be substitution of data from tables in a SQL Server database.

Has anyone else done this?
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

Jeff_KingstonConnect With a Mentor Author Commented:
Here is code I found for vbscript and I have modified to allow selection of records by date range.
Sub SaveCalendarToExcel()
'Created by Helen Feddema 9-17-2004
'Last modified 9-17-2004
'Demonstrates pushing Calendar data to rows in an Excel worksheet

On Error GoTo ErrorHandler

   Dim appWord As Word.Application
   Dim appExcel As Excel.Application
   Dim wkb As Excel.Workbook
   Dim wks As Excel.Worksheet
   Dim rng As Excel.Range
   Dim strSheet As String
   Dim strTemplatePath As String
   Dim i As Integer
   Dim j As Integer
   Dim lngCount As Long
   Dim nms As Outlook.Namespace
   Dim fld As Outlook.MAPIFolder
   'Must declare as Object because folders may contain different
   'types of items
   Dim itm As Object
   Dim strTitle As String
   Dim strPrompt As String
   'Pick up Template path from the Word Options dialog
   Set appWord = GetObject(, "Word.Application")
   strTemplatePath = appWord.Options.DefaultFilePath(wdUserTemplatesPath) & "\"
   Debug.Print "Templates folder: " & strTemplatePath
   strSheet = "Calendar.xls"
   strSheet = strTemplatePath & strSheet
   Debug.Print "Excel workbook: " & strSheet

   'Test for file in the Templates folder
   If TestFileExists(strSheet) = False Then
      strTitle = "Worksheet file not found"
      strPrompt = strSheet & _
         " not found; please copy Calendar.xls to this folder and try again"
      MsgBox strPrompt, vbCritical + vbOKOnly, strTitle
      GoTo ErrorHandlerExit
   End If
   Set appExcel = GetObject(, "Excel.Application")
   appExcel.Workbooks.Open (strSheet)
   Set wkb = appExcel.ActiveWorkbook
   Set wks = wkb.Sheets(1)
   appExcel.Application.Visible = True

   'Let user select a folder to export
   Set nms = Outlook.GetNamespace("MAPI")
   'Set nms = Application.GetNamespace("MAPI")
   Set fld = nms.PickFolder
   If fld Is Nothing Then
      GoTo ErrorHandlerExit
   End If
   'Test whether selected folder contains contact items
   If fld.DefaultItemType <> olAppointmentItem Then
      MsgBox "Folder is not a calendar folder"
      GoTo ErrorHandlerExit
   End If
   lngCount = fld.Items.Count
   If lngCount = 0 Then
      MsgBox "No appointments to export"
      GoTo ErrorHandlerExit
      Debug.Print lngCount & " appointments to export"
   End If

   'Adjust i (row number) to be 1 less than the number of the first body row
   i = 1
  'Iterate through contact items in Calendar folder, and export a few fields
   'from each item to a row in the Calendar worksheet
   For Each itm In fld.Items
      If itm.Class = olAppointment Then
         'Process item only if it is an appointment item
         'j is the column number
         j = 1
         If DateValue(itm.Start) >= DateValue(StartDate.Text) And DateValue(itm.Start) <= DateValue(EndDate.Text) Then
            i = i + 1
            Set rng = wks.Cells(i, j)
            If itm.Start <> "" Then rng.Value = itm.Start
            j = j + 1
            Set rng = wks.Cells(i, j)
            If itm.End <> "" Then rng.Value = itm.End
            j = j + 1
            Set rng = wks.Cells(i, j)
            If itm.CreationTime <> "" Then rng.Value = itm.CreationTime
            j = j + 1
            Set rng = wks.Cells(i, j)
            If itm.Subject <> "" Then rng.Value = itm.Subject
            j = j + 1
            Set rng = wks.Cells(i, j)
            If itm.Location <> "" Then rng.Value = itm.Location
            j = j + 1
            Set rng = wks.Cells(i, j)
            If itm.Categories <> "" Then rng.Value = itm.Categories
            j = j + 1
            Set rng = wks.Cells(i, j)
            If itm.IsRecurring <> "" Then rng.Value = itm.IsRecurring
            j = j + 1
            Set rng = wks.Cells(i, j)
            On Error Resume Next
         'The next line illustrates the syntax for referencing
         'a custom Outlook field
            'If itm.UserProperties("CustomField") <> "" Then
            'rng.Value = itm.UserProperties("CustomField")
            'End If
            j = j + 1
          End If
        End If
      'i = i + 1
   Next itm

   Exit Sub

   If Err.Number = 429 Then
      'Application object is not set by GetObject; use CreateObject instead
      If appWord Is Nothing Then
         Set appWord = CreateObject("Word.Application")
         Resume Next
      ElseIf appExcel Is Nothing Then
         Set appExcel = CreateObject("Excel.Application")
         Resume Next
      End If
      MsgBox "Error No: " & Err.Number & "; Description: "
      Resume ErrorHandlerExit
   End If

End Sub

Public Function TestFileExists(strFile As String) As Boolean
'Created by Helen Feddema 9-1-2004
'Last modified 9-1-2004
'Tests for existing of a file, using the FileSystemObject
   Dim fso As New Scripting.FileSystemObject
   Dim fil As Scripting.File
On Error Resume Next

   Set fil = fso.GetFile(strFile)
   If fil Is Nothing Then
      TestFileExists = False
      TestFileExists = True
   End If
End Function

I am loading into an excel spreadsheet and importing to a table in SQL modifying some of the data and createing on the fly .ics files that will be linked to fro an email sent to all attendees of the meeting/seminar so they can add to their own exchange server calendar for reminder.



Exchange 2003 is outdated by Exchange 2007 and Exchange 2010.  There is better programming from what I can tell against users/mailboxes rather then public folders.

.ics files can be modified and downloaded, you would even be able to add email addresses for meeting invites.

this web site has lots of pointers for solutions for MS Exchange

I have seen websites that create an ics file for the visitor to accept / import. I guess you have a web form that will create an ics then verify fields on before posting to a public folder / mailbox?

Hope that helps some.
Jeff_KingstonAuthor Commented:
A tip of the hat to Helen.

I searched for a resolution to this for 3 weeks and somehow stumbled into this code which was clear,simple to modify stick into a vb app then modifications were simple to do.
All Courses

From novice to tech pro — start learning today.