Solved

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

Posted on 2010-11-23
5
1,025 Views
Last Modified: 2012-05-10
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?
0
Comment
Question by:Jeff_Kingston
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
5 Comments
 
LVL 15

Expert Comment

by:markpalinux
ID: 34244978

Jeff,

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
http://www.slipstick.com/

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.
Mark
0
 

Accepted Solution

by:
Jeff_Kingston earned 0 total points
ID: 34369452
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)
   wks.Activate
   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
   Else
      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

ErrorHandlerExit:
   Exit Sub

ErrorHandler:
   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
   Else
      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
   Else
      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.

0
 

Author Closing Comment

by:Jeff_Kingston
ID: 34399102
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.
0

Featured Post

Back Up Your Microsoft Windows Server®

Back up all your Microsoft Windows Server – on-premises, in remote locations, in private and hybrid clouds. Your entire Windows Server will be backed up in one easy step with patented, block-level disk imaging. We achieve RTOs (recovery time objectives) as low as 15 seconds.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
This video discusses moving either the default database or any database to a new volume.
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.
Suggested Courses

624 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question