Changes to meeting body not properly saving

[erichamion]

I'm trying to create an appointment from a template, then make specific substitutions throughout the subject, location, and body of the appointment. The body substitutions are done with the WordEditor because I need to preserve formatting. It's almost working, but there's a quirk I can't figure out. Any help would be greatly appreciated.

The appointment is created, and the substitutions appear to work, but I then actually need to save changes through the user interface in order for the body substitutions to remain. When I open the appointment for the first time and then close it with the red "X", I'm prompted whether to save changes. If I choose "No", then the subject and location remain correct, but the appointment body reverts back to the template. If I move the meeting to a different time before ever opening it, then the body reverts without any prompt (although, again, the subject and location keep their substitutions).

I can work around the first issue easily by always saving changes or using the "Save and Close" button. The second issue (yes, it's really just a different aspect of the same issue) is a big problem because these appointments do typically get moved around. If I'm careless and don't open the appointment first, then it's lost.

Could somebody please help with identifying what I'm missing? Thank you.

This is using Outlook 2013, and the calendar is on an Exchange server. The script below requires a reference to the Word object library, and templatePath should be changed to the location of a meeting template that has one or more of the strings "<<~Foo~>>", "<<~Bar~>>", and "<<~Baz~>>" in both the subject and the body.

Option Explicit 
 
Sub calTest() 
    Dim fields As Collection 
    Const templatePath As String = "E:\Example.oft" 
  
   Set fields = getFieldsTest() 
  
   fillTemplateTest fields, templatePath 
End Sub 
 
Sub fillTemplateTest(fields As Collection, templatePath As String) 
    Dim objAppointment As Outlook.AppointmentItem 
    Dim appointmentDoc As Word.Document 
    Dim subject As String 
    'Dim location As String 
    Dim baseIndex As Long 
    Dim indexOne As Long 
    Dim indexTwo As Long 
    Dim matchStr As String 
    Dim replStr As String 
    Dim textRange As Range 
    Dim fullText As String 
    Dim objFind As Word.Find 
 
  Set objAppointment = Application.CreateItemFromTemplate(templatePath) 
    objAppointment.Start = Now 
    objAppointment.End = DateAdd("n", 30, Now) 
  
   subject = objAppointment.subject 
    indexOne = InStr(subject, "<<~") 
    Do While indexOne > 0 
        indexTwo = InStr(indexOne, subject, "~>>") 
        If indexTwo > indexOne Then 
            matchStr = Mid(subject, indexOne, indexTwo - indexOne + 3) 
            replStr = "" 
            On Error Resume Next 
            replStr = fields.Item(Mid(matchStr, 4, Len(matchStr) - 6)) 
            On Error GoTo 0 
            subject = Replace(subject, matchStr, replStr) 
          
           indexOne = indexOne - 1 
        End If 
      
       indexOne = InStr(indexOne + 1, subject, "<<~") 
    Loop 
    objAppointment.subject = subject 
  
   'Repeat the above block using objAppointment.location 
    'Removed from example as unnecessary.  Modifying location 
    'works just as well as modifying subject. 
  
   'Adding the line below so that we save before getting the WordEditor 
    '(and still save again later on) made no difference 
    'objAppointment.Save 
  
   Set appointmentDoc = objAppointment.GetInspector.WordEditor 
    Set textRange = appointmentDoc.Range 
    fullText = textRange.Text 
    indexOne = InStr(fullText, "<<~") 
    Do While indexOne > 0 
        indexTwo = InStr(indexOne, fullText, "~>>") 
        If indexTwo > indexOne Then 
            Set objFind = textRange.Find 
            objFind.Text = Mid(fullText, indexOne, indexTwo - indexOne + 3) 
            replStr = " " 
            On Error Resume Next 
            replStr = fields.Item(Mid(objFind.Text, 4, Len(objFind.Text) - 6)) 
            On Error GoTo 0 
            If objFind.Execute Then 
                textRange.Text = replStr 
                indexOne = baseIndex 
            Else 
                baseIndex = indexOne 
            End If 
          
           Set textRange = appointmentDoc.Range 
            fullText = textRange.Text 
        End If 
      
       indexOne = InStr(indexOne + 1, fullText, "<<~") 
    Loop 
  
   objAppointment.Save 
    Set objAppointment = Nothing 
  
   'Adding the line below immediately discards all changes to the 
    'appointment body. 
    'appointmentDoc.Close 
  
   'Adding the line below prompts the user for a location 
    'to save a file, which is not what we want. 
    'appointmentDoc.Save 
    Set appointmentDoc = Nothing 
   
 
End Sub 
 
Function getFieldsTest() As Collection 
    Dim RetVal As Collection 
  
   Set RetVal = New Collection 
    RetVal.Add Item:="Pike", key:="Foo" 
    RetVal.Add Item:="Kirk", key:="Bar" 
    RetVal.Add Item:="Picard", key:="Baz" 
  
   Set getFieldsTest = RetVal 
    Set RetVal = Nothing 
End Function

 

[Diane Poremsky]

So objAppointment.Save doesn't actually do anything? (at least as far as the body text is concerned)

 

[erichamion]

Well, the appointment isn't visible on the calendar until it's saved, so I wouldn't say it's doing nothing. But you're right, it's not saving the changes to the body.

Since posting, I've found that if I display and close the appointment through VBA, the changes are saved. It also works as expected if I just use objAppointment.Body for text replacement (but it kills the formatting, of course). So it will work by replacing objAppointment.Save with either:

objAppointment.Display
objAppointment.Save
objAppointment.Close olDiscard​

Or just:

objAppointment.Display
objAppointment.Close olSave
​

That works, although I'm not fond of the flickering windows. This is typically being called several times in a row to create three or four appointments, so the flickering would be a nuisance.

It seems like the appointment's Word document isn't really syncing up with the actual appointment until it's shown somehow. Is there a good way around this, or is flickering windows the best solution?

Thank you very much, Diane.

 

[Diane Poremsky]

i will see what i can find out -

 

[erichamion]

Aha! I found the answer at http://social.msdn.microsoft.com/Fo...nging-getinspectorwordeditor?forum=outlookdev. If I replace objAppointment.Save with:
Set objPages = objAppointment.GetInspector.ModifiedFormPages
objPages.Add "General"
objAppointment.GetInspector.HideFormPage "General"
objAppointment.Close olSave

(with "Dim objPages as Outlook.Pages" earlier), it works without trying to open any windows. I'm pretty inexperienced at this and have never worked with form pages. I don't really know what this is doing or why it works, but it works.

Thank you.