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

S

Sonnydl

Registered User.
Local time
Today, 00:33
Joined
Jul 3, 2018
Messages
41
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 (I was guessing here) 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!
 
theDBguy

theDBguy

I’m here to help
Staff member
Local time
Today, 00:33
Joined
Oct 29, 2018
Messages
21,449
Hi. Just thinking out loud, but I am guessing the difference is emails get sent while events don't, which probably means there is no error to trap for events, when canceled, not like when emails are not sent.
 
M

Micron

AWF VIP
Local time
Today, 03:33
Joined
Oct 20, 2018
Messages
3,478
There is a Saved property for an Outlook appointment item but it returns true or false according to whether or not the item was modified after the last save. It's kind of like a form's Dirty event. I don't have an answer, but wonder if you can attempt to Save it in code. If it errs, it doesn't exist. Just guessing.

EDIT - another thought: try to get a property of the item, such as IsRecurring or Importance or some other property you have set. If it doesn't error, it was saved.
Any particular reason you don't just save it from Access?
 
Last edited:
S

Sonnydl

Registered User.
Local time
Today, 00:33
Joined
Jul 3, 2018
Messages
41
Yes, same post, different site. Are these sites the same? If so, I didn't know that they are seen by all the same people and was trying to expand my audience to increase my chances of getting assistance.
 
S

Sonnydl

Registered User.
Local time
Today, 00:33
Joined
Jul 3, 2018
Messages
41
Micron said:
possibly cross posted under different user name?
Click to expand...

Yes. Cross posted. Thank you for putting the links cross-post links in each thread. I meant no offense.

I tried your suggestion of checking for AllDayEvent, since I'd set that for True.

Code: 
    On Error Resume Next
        CreateCalendarItem = .AllDayEvent
        If Err = 0 Then
            CreateCalendarItem = False
        Else
            CreateCalendarItem = True
        End If

No joy. I get False whether I save it or not.
 
S

Sonnydl

Registered User.
Local time
Today, 00:33
Joined
Jul 3, 2018
Messages
41
So I found this at another site:

Cannot post link as I only have 9 of the 10+ posts needed.

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
 
pbaldy

pbaldy

Wino Moderator
Staff member
Local time
Today, 00:33
Joined
Aug 30, 2003
Messages
36,123
Post 8 was moderated, I'm posting to trigger email notifications.
 
pbaldy

pbaldy

Wino Moderator
Staff member
Local time
Today, 00:33
Joined
Aug 30, 2003
Messages
36,123
Sonnydl said:
Can you also state how it was moderated, so that I know what is offending?
Click to expand...

To be honest I can't tell. Usually it's a link or something. Nothing in that post jumps out at me. I wouldn't worry about it, you didn't do anything wrong and the forum software probably won't do it any more as you accumulate posts.
 
S

Sonnydl

Registered User.
Local time
Today, 00:33
Joined
Jul 3, 2018
Messages
41
Update: Based on further searches, I got to here:

https://stackoverflow.com/questions/1927799/iterating-quickly-through-outlook-appointment-items

which links to here:

https://docs.microsoft.com/en-us/of...s-within-a-date-range-that-contain-a-specific

Which led me to clean up my code so that I'm restricting my search parameter before I look for the Outlook Calendar Item that I have (or haven't) just created. I wish I understood working with Outlook better, but it is what it is.

Bottom line: It works and it's much faster.

The code is as follows:
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 olAppt As Outlook.AppointmentItem
Dim olCalendar As Outlook.Folder
Dim olItems As Outlook.Items
Dim sFilter As String

Set appOutlook = CreateObject("Outlook.Application")
Set olAppt = appOutlook.CreateItem(olAppointmentItem)
Set olCalendar = olAppt.Session.GetDefaultFolder(olFolderCalendar)
Set olItems = olCalendar.Items

With olAppt
    .ReminderSet = False
    .Start = dtStart
    .End = dtEnd
    .AllDayEvent = True
    .Subject = sSubject
    .Location = sLocation
    .Body = sItin
    .Display True
End With

sFilter = "[Start] = '" & Format(dtStart, "mm/dd/yyyy hh:mm AMPM") & "'"

Set olItems = olItems.Restrict(sFilter)

CreateCalendarItem = False
For Each olAppt In olItems
    If olAppt.Subject = sSubject Then
        CreateCalendarItem = True
    End If
Next
   
Set olItems = Nothing
Set olCalendar = Nothing
Set olAppt = Nothing
Set appOutlook = Nothing

End Function

I'll give this a bit to see if anyone can solve it through the original process before I mark this as SOLVED.
 
You must log in or register to reply here.

Similar threads

H
Solved Open Outlook Maximized
Replies
10
Views
889
HillTJ
H
B
Update main form text boxes as subform is filled in? Also, subforms not linking?
Replies
4
Views
410
gemma-the-husky
gemma-the-husky
M
Solved VBA access to outlook email with table: aligning table cells
Replies
5
Views
1,877
miacino
M
M
Solved Create directory if not exist and save report
Replies
11
Views
757
Gasman
Gasman
K
Linking access with outlook
Replies
10
Views
1,436
Kuleesha
K

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom