Send Email Appointment from Access using vba

Hi,

I currently send emails from Access 2007 using Outlook 2007 Automation that include text outlining client appointment dates and times.

I would like to add a calendar attachment to the email but am not able to get my vba code to work.

Does anyone have a working code snippet they can provide to get me on track.

Thanks.
isurgynAsked:
Who is Participating?
 
isurgynAuthor Commented:
OK I finally got the following code to work correctly.  It is a bit rough and perhaps is not the best Error Handling routines but it does work beautifully!

I have to admit I searched Google and Bing for hours and found no properly working code to do this.  Thanks for providing direction.  I am certain that the vbMAPI is a good solution as well.

Also one can add more options on the ics file.  Just consult the appropriate MSDN files.

  Dim strMsg As String
  Dim iResponse As Integer
 
    If IsNull(Me.Email) Or Me.Email = "" Then GoTo ErrHandler1
 
  ' Check if Outlook is already running
   
    Dim olApp As Object
    Dim OutlookWasNotRunning As Boolean
    Dim strAppName As String
    Dim myRecipient As Object
    Dim toStr As String
 
    On Error Resume Next  'Simplest way to check for Outlook instance
   
      Set olApp = GetObject(, "Outlook.Application")
      If Err.Number <> 0 Then
         Err.Clear
         OutlookWasNotRunning = True
         strAppName = "C:\Program Files\Microsoft Office\Office12\Outlook.exe"
        Call Shell(strAppName, vbMinimizedFocus)
      Else
         Set olApp = GetObject("Outlook.Application")
      End If
     
    '  Now Outlook has been opened if it was not open
   
    On Error GoTo ErrHandler2
 
    Dim myOlApp As Outlook.Application
    Dim outAppt As Outlook.AppointmentItem
 
    Set outAppt = olApp.CreateItem(olAppointmentItem)
    toStr = Me.Email
    Set myRecipient = outAppt.Recipients.Add(toStr)
           
        With outAppt
 
            .Subject = "A new appointment has been booked for you"
 
            .Location = "Office 1"
 
            .MeetingStatus = olMeeting
 
            .Start = #12/10/2012# & " " & #9:15:00 AM#
 
            .End = #12/10/2012# & " " & #10:15:00 AM#
 
            .RequiredAttendees = Me.Email  'Very important- this must be a valid email
 
            .Body = "Very Important Meeting"
 
            .Send
 
            Set outAppt = Nothing
            Set myOlApp = Nothing
            Set olApp = Nothing
           
            End With
           
        Exit Sub
 
ErrHandler1:
 
    strMsg = "There is no email entered for this patient" & Chr(10)
    strMsg = strMsg & "Add and email address then proceed again" & Chr(10)
   
    iResponse = MsgBox(strMsg, vbOKOnly, "No Email Address Exists")
   
        Cancel = True
       
    Exit Sub
   
ErrHandler2:
   
    strMsg = "Err = " & Err.Number & " Error Description = " & Err.Description
0
 
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
but am not able to get my vba code to work.
Always a good idea to include your code when posting questions like this.

FWIW, I use vbMAPI when working with Outlook from Access (www.everythingaccess.com). It's an addin that takes the work out of working with Outlook, and is well worth the cost.
0
 
isurgynAuthor Commented:
My code was too embarrasing to post.

I took a quick look at vbMAPI website.  I will definitely check it out.

Thanks.
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
isurgynAuthor Commented:
I am posting my current code for sending email via Outlook that works just fine.  However, as stated I would like to add an Outlook Appointment attachment that I can send as well so that the person can choose to accept the appointment and add it to their calendar.  The vbMAPI solution will logically work but it appears that I will need to recode the entire email process using that plugin.  It seems that it can't be that much to simply add the Appointment attachment code to my current process.

    Dim strMsg As String
    Dim iResponse As Integer
   
    If IsNull([Email]) Or [Email] = "" Then GoTo ErrHandler

  ' Check if Outlook is already running
   
    Dim olApp As Object
    Dim OutlookWasNotRunning As Boolean
    Dim strAppName As String

    On Error Resume Next
   
      Set olApp = GetObject(, "Outlook.Application")
      If Err.Number <> 0 Then
         Err.Clear
         OutlookWasNotRunning = True
         strAppName = "C:\Program Files\Microsoft Office\Office12\Outlook.exe"
        Call Shell(strAppName, vbMinimizedFocus)
      Else
         Set olApp = GetObject("Outlook.Application")
      End If
     
    '  Now Outlook has been opened if it was not open
   
    '  Send HTML email next

    Dim myOlApp As Outlook.Application
    Dim MyItem As Outlook.MailItem
    Dim objDoc As Object
    Dim OutlookRecip As Object
    Dim myRecipient As Object
   
    Dim strTo As String
    Dim strTodaysDate As String
    Dim strApptDate As String
    Dim strApptTime As String
    Dim strApptMonth As String
    Dim strApptWeekDay As String
    Dim strApptDay As String
    Dim strApptYear As String
    Dim strApptType As String
    Dim strAppt As String
    Dim strName As String
    Dim strHTML As String
   
    strApptTime = TimeValue([DateApptScheduled])
    strApptDate = DateValue([DateApptScheduled])
    strApptDay = Day([DateApptScheduled])
    strApptWeekDay = WeekdayName(Weekday([DateApptScheduled]))
    strApptMonth = MonthName(Month([DateApptScheduled]))
    strApptYear = Year([DateApptScheduled])
    strTodaysDate = Format(Date, "dddd, mmmm dd, yyyy")
    strApptType = [VisitType]
    strAppt = strApptWeekDay & ", " & strApptMonth & " " & strApptDay & ", " & strApptYear
    strName = [First]
    strTo = [Email]
     
    If Me.ProviderID = 3 Then strApptType = "Post-operative Checkup in Office 1"
   
    If Me.ProviderID = 5 Then strApptType = "Post-operative Checkup in Office 2"
 
    If Me.ProviderID = 7 Then strApptType = "Post-operative Checkup in Office 3"

    If Me.ProviderID = 2 Then strApptType = "Comprehensive Eye Examination in Office 1"

    If Me.ProviderID = 4 Then strApptType = "Comprehensive Eye Examination in Office 2"

    If Me.ProviderID = 6 Then strApptType = "Comprehensive Eye Examination in Office 3"

    If Me.ProviderID = 8 Then strApptType = "Surgery in Office 1"
   
    If Me.ProviderID = 9 Then strApptType = "Surgery in Office 2"
   
    Set myOlApp = CreateObject("Outlook.Application")

    Set MyItem = myOlApp.CreateItemFromTemplate("C:\Template1.oft")
   
        With MyItem
   
            Set myRecipient = MyItem.Recipients.Add(strTo)
            .Subject = "Your appointment at Our Office"
            .Importance = 1
           
        End With
       
    MyItem.HTMLBody = Replace(MyItem.HTMLBody, "%text1%", strTodaysDate)
    MyItem.HTMLBody = Replace(MyItem.HTMLBody, "%text2%", strName)
    MyItem.HTMLBody = Replace(MyItem.HTMLBody, "%text3%", strAppt)
    MyItem.HTMLBody = Replace(MyItem.HTMLBody, "%text4%", strApptTime)
    MyItem.HTMLBody = Replace(MyItem.HTMLBody, "%text5%", strApptType)
    MyItem.Display
    Set objDoc = MyItem.GetInspector.WordEditor
    objDoc.Windows(1).Selection.Find.ClearFormatting
    objDoc.Windows(1).Selection.Find.Execute strSender
    Set myOlApp = Nothing
    Set objDoc = Nothing
   
    Exit Sub

ErrHandler:

    strMsg = "There is no email entered for this patient" & Chr(10)
    strMsg = strMsg & "Add and email address then proceed again" & Chr(10)
   
    iResponse = MsgBox(strMsg, vbOKOnly, "No Email Address Exists")
   
        Cancel = True



This is some vba code that I found using Google but I have not been successful at integrating it with my email vba code.  Any thoughts before I try the vbMAPI solution?



Dim outMail As Outlook.AppointmentItem

Set outMail = Outlook.CreateItem(olAppointmentItem)

outMail.Subject = "A new appointment has been booked for me"

outMail.Location = "Nowhere"

outMail.MeetingStatus = olMeeting

outMail.Start = #2/8/2008# & " " & #9:15:00 AM#

outMail.End = #2/8/2008# & " " & #10:15:00 AM#

outMail.RequiredAttendees = "Email addresses for attendees"

outMail.Body = "No Reason"

outMail.Send

Set outMail=Nothing


Thanks.
0
 
Scott McDaniel (Microsoft Access MVP - EE MVE )Infotrakker SoftwareCommented:
Have you tried your appointment code with your Outlook item:

Set myOlApp = CreateObject("Outlook.Application")
Dim outMail As Outlook.AppointmentItem

Set outMail = OlApp.CreateItem(olAppointmentItem)

outMail.Subject = "A new appointment has been booked for me"

outMail.Location = "Nowhere"
0
 
isurgynAuthor Commented:
The solution provided was the final outcome of the input from other Experts, however no input suggested a proper solution using vba code. As a result, I chose my own solution that solved the problem exactly as required.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.