Results 1 to 4 of 4
  1. #1
    MykelDL is offline Novice
    Windows 10 Access 2013 64bit
    Join Date
    May 2017
    Posts
    22

    Marking a VBA Created Calendar Item as Saved (or Not)

    Hello,

    I've got a function set up wherein I take HTML-formatted text that I've created in Access (it's a travel itinerary) and send it via Outlook. As a part of this function, the email is displayed for inspection, then, if sent, it captures that fact (boolean) so that I can acknowledge it in a Sub and put the date it was sent and add notes into the associated record.

    This is the end of the Sub that builds the itinerary:

    Code:
    ...
    'All the stuff to build the itinerary and pull together the items needed for the email
    ...
    
    bSent = SendAnEmail(sRecipient, sBCC, sEmailSubject, sEmailBody, sOutgoingEmailAcct)
    
    If bSent = False Then GoTo Exiting
    
    Select Case bNew 'This is defined earlier in the Sub and drives what to do if the itinerary is sent.
        Case 1
            Me.txtItinSent = Date
            AddBookingNote Me.txtBookingID, "Itinerary Sent. -" & Now()
            ItinCalendar
        Case 2
            Me.chkInCalendar = False
            Me.txtDateConfirmed = Null
            Me.txtItinSent = Date
            AddBookingNote Me.txtBookingID, "Revised Itinerary Sent. -" & Now()
            ItinCalendar
        Case 3
            AddBookingNote Me.txtBookingID, "Duplicate Itinerary Resent. -" & Now()
        Case 4
            Me.txtItinSent = Date
            AddBookingNote Me.txtBookingID, "Existing Itinerary Resent. -" & Now()
    End Select
    
    Exiting:
        rs.Close
        Set rs = Nothing
    This is the function that sends the eMail and returns whether or not the Itinerary was sent:



    Code:
    Public Function SendAnEmail(sRecipient As String, sBCC As String, sSubject As String, sEmailBody As String, sAccount As String, Optional sAttach As String) As Boolean
    
    Dim appOutlook As Outlook.Application
    Dim MailOutlook As Outlook.MailItem
    
    Set appOutlook = CreateObject("Outlook.Application")
    Set MailOutlook = appOutlook.CreateItem(olMailItem)
    
    With MailOutlook
        .SendUsingAccount = .Session.Accounts.Item(sAccount)
        .To = sRecipient
        .BCC = sBCC
        .Subject = sSubject
        .HTMLBody = sEmailBody
        If sAttach <> "" Then .Attachments.Add sAttach
        .Display True
        
        On Error Resume Next
            SendAnEmail = .Sent
            If Err = 0 Then
                SendAnEmail = False
            Else
                SendAnEmail = True
            End If
    End With
    
    Set appOutlook = Nothing
    Set MailOutlook = Nothing
    
    End Function
    It all works very nice. If the email is sent, the record is updated through the form and a note is added. If there's a mistake in the itinerary, I just hit close, decline to Save it on the ensuing dialog box, and nothing else happens. All good.

    Now, I want to do the same thing for an Outlook Calendar Item. I can build the itinerary for the body (non-html), create the Calendar item, etc. but I don't know how to make the "check to see if it was saved to the calendar or cancelled" part work.

    I have the following, but when using .Saved there's no difference in the outcome if I actually Save the item or Cancel and Discard it--it's FALSE either way. Other than that, it works. It creates the item and either puts it in the calendar (if saved) or doesn't (if cancelled.) I just can't figure out how to record the difference.

    Code:
    Public Function CreateCalendarItem(sAcct As String, dtStart As Date, dtEnd As Date, sSubject As String, sLocation As String, sItin As String) As Boolean
    
    Dim appOutlook As Outlook.Application
    Dim ApptOutlook As Outlook.AppointmentItem
    
    
    Set appOutlook = CreateObject("Outlook.Application")
    Set ApptOutlook = appOutlook.CreateItem(olAppointmentItem)
    
    
    With ApptOutlook
        .ReminderSet = False
        .Start = dtStart
        .End = dtEnd
        .AllDayEvent = True
        .Subject = sSubject
        .Location = sLocation
        .Body = sItin
        .Display True
    
        On Error Resume Next
            CreateCalendarItem = .Saved
            If Err = 0 Then
                CreateCalendarItem = False
            Else
                CreateCalendarItem = True
            End If
    
    End With
    
    End Function
    I appreciate your help!

  2. #2
    Micron is online now Virtually Inert Person
    Windows 10 Access 2016
    Join Date
    Jun 2014
    Location
    Ontario, Canada
    Posts
    12,737
    You have cross posted this under a different user name?
    https://www.access-programmers.co.uk...49#post1655149
    The more we hear silence, the more we begin to think about our value in this universe.
    Paraphrase of Professor Brian Cox.

  3. #3
    MykelDL is offline Novice
    Windows 10 Access 2013 64bit
    Join Date
    May 2017
    Posts
    22
    So I found this at another site with this:

    https://www.mrexcel.com/board/thread...hanged.832092/

    I've adapted it to run after my item is Saved or Cancelled. It takes some time because it searches through all the calendar items, but it works. I just wish I had something more efficient or easier. Also, since I'm not a VBA maven, I'm not sure if I need all the code there (e.g., namespace), but I was able to parse it a little.


    Here what I now have:
    Code:
    Public Function CreateCalendarItem(sAcct As String, dtStart As Date, dtEnd As Date, sSubject As String, sLocation As String, sItin As String) As Boolean
    
    
    Dim appOutlook As Outlook.Application
    Dim ApptOutlook As Outlook.AppointmentItem
    
    
    Set appOutlook = CreateObject("Outlook.Application")
    Set ApptOutlook = appOutlook.CreateItem(olAppointmentItem)
    
    
    With ApptOutlook
    
    
        .ReminderSet = False
        .Start = dtStart
        .End = dtEnd
        .AllDayEvent = True
        .Subject = sSubject
        .Location = sLocation
        .Body = sItin
        .Display True
    
    
    End With
    
    
    Dim oNameSpace As Outlook.Namespace
    Dim oFolder As Outlook.MAPIFolder
    Dim oObject As Object
      
      Set oNameSpace = appOutlook.GetNamespace("MAPI")
      Set oFolder = oNameSpace.GetDefaultFolder(olFolderCalendar)
      
    CreateCalendarItem = False
    For Each oObject In oFolder.Items
        If oObject.Class = olAppointment Then
            Set ApptOutlook = oObject
            If ApptOutlook.Subject = sSubject Then
                CreateCalendarItem = True
            End If
        End If
    Next oObject
        
    Set oObject = Nothing
    Set oFolder = Nothing
    Set oNameSpace = Nothing
    
    
    Set ApptOutlook = Nothing
    Set appOutlook = Nothing
    
    
    End Function

  4. #4
    MykelDL is offline Novice
    Windows 10 Access 2013 64bit
    Join Date
    May 2017
    Posts
    22
    Update: I have a solution, which can be seen at: https://www.access-programmers.co.uk...d.php?t=308284 (Yes, I unknowingly violated the cross-posting etiquette. I didn't even know what "cross-posting" was. I thought it was posting the same question in multiple section of the same forum... not completely different help forums.)

    However, I'm curious if anyone has a better solution.

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Replies: 4
    Last Post: 05-30-2016, 10:53 AM
  2. Automated marking off stock levels
    By bbdsbd in forum Access
    Replies: 1
    Last Post: 07-29-2015, 05:07 AM
  3. Replies: 4
    Last Post: 06-05-2014, 02:24 PM
  4. Action on record before PK is created (record saved)
    By chris.williams in forum Forms
    Replies: 4
    Last Post: 09-14-2012, 10:41 PM
  5. checking a query when marking a checkbox
    By vt800c in forum Access
    Replies: 2
    Last Post: 05-13-2011, 08:53 AM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums