Appointment item bug on copying text

[TheAkira]

Hi,

I'm working on this code to create an Outlook appointment from Excel. And a part of this code is to insert a formatted text inside the Body, once the AppointmentItem isn't formattable at all. It works like that:


I first create an MailItem, and use the HTMLBody to insert and format my text.
Not even need to Display this item, and I use a command to copy the formatted text (storing the text in the Windows clipboard [CTRL+C]).
Now I create the AppointmentItem and use another command to paste the text inside the Appointment Body (Not exactly the text, but everything which is inside Windows clipboard [CTRL+V]).



Well, works fine, but I would like to avoid this CTRL+C_&_CTRL+V thing, if it is even possible. But this isn't my main concern since I'm getting these "bugs":

- First bug: If I load this code twice in a row, It should display two Outlook appointments, each one with the formatted text. But the first appointment shows the text duplicated, and the second one shows nothing.

- Second bug: Im using a code to unlock the Word document (since Im using.GetInspector.WordEditor Property), but even using this code, sometimes he shows this error and highlight the B5.PasteAndFormat (wdFormatOriginalFormatting) line:

"This method or property is not available because the document is locked for editing."


But sometimes works fine.
Well, that is it, sorry about this topic so huge. But I have no idea what is happening.
My code:



Set oApp = CreateObject("Outlook.Application")
'========================================================================== ==============
'//EMAIL
'========================================================================== ==============
Set ItemEmail = oApp.CreateItem(0)

With ItemEmail
.HTMLBody = " <b>text text text</b> "
End With

Set A1 = ItemEmail
Set A2 = A1.GetInspector
Set A3 = A2.WordEditor
Set A4 = A3.Range

'//Protected file
Set Protegido = ItemEmail.GetInspector.WordEditor
If Protegido.ProtectionType <> wdNoProtection Then
Protegido.Unprotect
End If

A4.FormattedText.Copy

ItemEmail.Close (olDiscard)
'________________________________________________________


'========================================================================== ==============
'// APPOINTMENT
'========================================================================== ==============
Set ItemAppoint = oApp.CreateItem(1)

With ItemAppoint
.Display
End With

'//Protected file
Set Protegido = ItemEmail.GetInspector.WordEditor
If Protegido.ProtectionType <> wdNoProtection Then
Protegido.Unprotect
End If

Set B1 = ItemAppoint
Set B2 = B1.GetInspector
Set B3 = B2.WordEditor
Set B4 = B3.Application
Set B5 = B4.Selection

B5.PasteAndFormat (wdFormatOriginalFormatting)

[TheAkira]

I just figured out about the first bug:

I replaced this:


Set B1 = ItemAppoint
Set B2 = B1.GetInspector
Set B3 = B2.WordEditor
Set B4 = B3.Application
Set B5 = B4.Selection

B5.PasteAndFormat (wdFormatOriginalFormatting)


To this:


Set B1 = ItemAppoint
Set B2 = B1.GetInspector
Set B3 = B2.WordEditor
Set B4 = B3.Range

B4.Paste (wdFormatOriginalFormatting)

[gmayor]

I don't know why you are using a message to create the text. You can format the text directly in the appointment body from VBA. There are a couple of provisos. It is better if you start Outlook before running the process as it works faster and more reliably if Outlook is running. You haven't said what it is that you are putting in the message body, or mentioned times etc, so I cannot help with that, but the following should get you started:
Option Explicit
Sub CreateOLAppt()
Dim olApp As Object
Dim ItemAppoint As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
'Outlook wasn't running, so warn the user and quit
If Err <> 0 Then
MsgBox "Ensure Outlook is running before using this macro"
Err.Clear
GoTo lbl_Exit
End If
Set ItemAppoint = olApp.CreateItem(1)
With ItemAppoint
.Subject = "Subject"
.Location = "Somewhere"
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
With oRng
.Text = "This is the body text of the appointment"
.Font.Name = "Times New Roman"
.Font.Size = 12
.Font.Italic = True
End With
.Display
End With
lbl_Exit:
Set olApp = Nothing
Set ItemAppoint = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Exit Sub
End Sub

[TheAkira]

Ok. But according with your code, I have to create an Object for each formatted text/phrase/letter that I want to write (?).
How I supposed to do if I want to write something like that:

"This is my meeting invitation"

[gmayor]

Not so! You only need to format the range as required. You can either add text to the range and format it, then collapse the range to its end before adding more text, or in the case of your example, you can simply format the words in the range e.g.


With oRng
.Text = "This is my meeting invitation"
.Font.Name = "Calibri"
.Words(1).Font.Name = "Courier New"
.Words(1).Font.ColorIndex = wdRed
.Words(2).Font.Name = "Courier New"
.Words(2).Font.ColorIndex = wdRed
.Words(1).Font.Italic = True
.Words(3).Font.ColorIndex = wdBlue
.Words(4).Font.ColorIndex = wdBlack
.Words(4).Font.Bold = True
.Words(5).Underline = wdUnderlineSingle
End With

[gmayor]

On further reflection, as you are not programming in Word itself, you need the numeric equivalents of the Word specific commands. Change wdRed to 6, wdBlue to 2, wdBlack to 1 and wdUnderlineSingle to 1

[TheAkira]

That's really cool. Thank you Gmayor.