×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

Bug When opening outlook to create a calendar entry

Bug When opening outlook to create a calendar entry

Bug When opening outlook to create a calendar entry

(OP)
To All

Can anyone help. I have some code (pasted below) which opens outlook from excel and creates a calendar invite. It works fine for about 70% of the time. For the remaining 30% I receive an error message stating the Microsoft Outlook has stopped working. When I click debug the line is highlighted as below. It seems that it may be happening when outlook is already open. I have tried to repeat the issue when outlook is closed when the code is triggered and cannot repeat the issue.

As always, any help would be appreciated

Here is the code

CODE -->

Sub Sample()

ActiveWorkbook.Save
Dim ol As Object
Dim Item As Object
 Const olAppointmentItem = 1
 'item As AppointmentItem
 Set ol = CreateObject("Outlook.Application")
 Set Item = ol.CreateItem(olAppointmentItem)
 
    StartDate = [C11]
    StartTime = [E11]
    EndDate = [G11]
    EndTime = [I11]
    TimingofWork = [K11]
    BuildingofWork = [C13]
    Title = [I13]
    DetailedDescriptionofWorks = [C15]
    ImplementationPlan = [F17]
    Whatmonitoring = [F19]
    Backoutplan = [F21]
    TestPlan = [F23]
    PostImplementationVerification = [F25]
    ImpacttoSytemOutputsandUsers = [C27]
    Otherifapplicable = [C29]
    CRNumber = [J31]
    
 'Set Start Date
 Item.Start = StartDate + TimeValue("00:00")
  'Set End Date
 Item.End = EndDate + TimeValue("00:30")
 'appointment subject
 Item.Subject = Title & " - " & BuildingofWork
 'location description
 Item.Location = BuildingofWork
 'body message
 Worksheets("Drop Down and Pastes").Range("C2:D22").Copy
Item.Display
Item.GetInspector.WordEditor.Windows(1).Selection.PasteAndFormat wdPASTERTF
 
 Item.Recipients.Add ("CR Notification Group")
 'set the busy status
 Item.BusyStatus = olFree
 'reminder before start
 Item.ReminderMinutesBeforeStart = 15
 'reminder activated
 Item.ReminderSet = True
 'duh! save the thing!
 Item.Display

 'garbage collection - kind of...
 Set ol = Nothing
 Set Item = Nothing

 'return true
 makeReminder = True
 End Sub 

RE: Bug When opening outlook to create a calendar entry

Firstly, check if you have reference to word library, if not, declare Const wdPasteRTF =2, otherwise it is 0 in the marked line.
Before Set ol = CreateObject("Outlook.Application") check if outlook is open, create outlook conditionally:

CODE -->

On Error Resume Next
Set ol = GetObject(, "Outlook.Application")
On Error GoTo 0
If ol Is Nothing Then Set ol = CreateObject("Outlook.Application") 

combo

RE: Bug When opening outlook to create a calendar entry

(OP)
Hi COmbo

I have updated the code as suggested and still experiencing the issue. My updated code is below

Any further help or advise would be appreciated

Many Thanks

CODE -->

Sub Sample()

ActiveWorkbook.Save
Dim ol As Object
Dim Item As Object
Const wdPASTERTF = 2
 Const olAppointmentItem = 1
 'item As AppointmentItem
On Error Resume Next
Set ol = GetObject(, "Outlook.Application")
On Error GoTo 0
If ol Is Nothing Then Set ol = CreateObject("Outlook.Application")

'Set ol = CreateObject("Outlook.Application")
Set Item = ol.CreateItem(olAppointmentItem)
 
 
 
 
    StartDate = [C11]
    StartTime = [E11]
    EndDate = [G11]
    EndTime = [I11]
    TimingofWork = [K11]
    BuildingofWork = [C13]
    Title = [I13]
    DetailedDescriptionofWorks = [C15]
    ImplementationPlan = [F17]
    Whatmonitoring = [F19]
    Backoutplan = [F21]
    TestPlan = [F23]
    PostImplementationVerification = [F25]
    ImpacttoSytemOutputsandUsers = [C27]
    Otherifapplicable = [C29]
    CRNumber = [J31]
    
 'Set Start Date
 Item.Start = StartDate + TimeValue("00:00")
  'Set End Date
 Item.End = EndDate + TimeValue("00:30")
 'appointment subject
 Item.Subject = Title & " - " & BuildingofWork
 'location description
 Item.Location = BuildingofWork
 'body message
 Worksheets("Drop Down and Pastes").Range("C2:C22").Copy
Item.Display
[highlight ]Item.GetInspector.WordEditor.Windows(1).Selection.PasteAndFormat wdPASTERTF[/highlight]
 
 Item.Recipients.Add ("CR Notification Group")
 'set the busy status
 Item.BusyStatus = olFree
 'reminder before start
 Item.ReminderMinutesBeforeStart = 15
 'reminder activated
 Item.ReminderSet = True
 'duh! save the thing!
 Item.Display

 'garbage collection - kind of...
 Set ol = Nothing
 Set Item = Nothing

 'return true
 makeReminder = True
 End Sub 

RE: Bug When opening outlook to create a calendar entry

With outlook already open your code works for me. A new appointment item is created basing on active sheet and "Drop Down and Pastes" sheet.
No reference to Word and Outlook libraries.
Does the code stops when outlook is both closed and opened?
You could try to debug the long path using immediate window and test objects, i.e declare oTest and next Set oTest=Item.GetInspector, add breakpoint in next line and check oTest. If it's OK, add next property/method (WordEditor here) and test again.

For clarity you can also declare olFree=0 and use oItem instead of Item, to avoid nabes identical to objects.

combo

RE: Bug When opening outlook to create a calendar entry

(OP)
Hi Combo

Many Thanks

I will try this and let you know

For reference the code often works for me when outlook is open. However, roughly every third or fourth attempt experiences the problem.

Thanks again

RE: Bug When opening outlook to create a calendar entry

(OP)
Hi Combo

Apologies but I'm a real novice here

I have opened the immediate window but no idea what to do next

If you could provide more help I'd really appreciate it

Thanks

RE: Bug When opening outlook to create a calendar entry

Sorry, wdPasteRTF=1 in word.
I was thinking about "Locals" window. When the code is running (so the breakpoint, you need to see current state), it displays locally declared variables and their current values. Expand object variable tree. Sometimes it's a bit confusing when you try to expand endless branch: Application has Application property that returns Application object, etc.

When digging the object structure, you expand the branch you are interested in. If you use code, for instanceit can be done with:
dim oInspector as object, oWordEditor As Object, oWindow As Object
Set oInspector = Item.GetInspector
Set oWordEditor = oInspector.WordEditor
Set oWindow = oWordEditor.windows(1)
MsgBox oWindow.Selection 
In case of error you can precisely see the source.

There is something wrong in the line:
Item.GetInspector.WordEditor.Windows(1).Selection.PasteAndFormat wdPASTERTF
PasteAndFormat has no wdPasteRTF, argument, you should put any of WdRecoveryType enumerated constants, and they take neither 1 nor 2. wdPasteRTF is a member of WdPasteDataType enum, which is a DataType argument type in PasteSpecial (instead of PasteAndFormat for Selection).

Generally, I recommend reviewing outlook and word object libraries (in outlook and word VBE object browsers). Note that without referencing outlook and word libraries (late binding) outlook and word named constants are not recognised in vba, they have default values, so you have either declare local constants (as: Const olAppointmentItem = 1) or use values (as: Set Item = ol.CreateItem(1)).

combo

RE: Bug When opening outlook to create a calendar entry

(OP)
Hi Combo

I have tried your recommendation and although I do not get the fault every time I do still see the fault

The coded stops at the line highlighted. Do you have any ideas on what could be causing this

Thanks

Here is the code

CODE -->

Dim oInspector As Object, oWordEditor As Object, oWindow As Object
Set oInspector = Item.GetInspector
Set oWordEditor = oInspector.WordEditor
Set oWindow = oWordEditor.Windows(1)
MsgBox oWindow.Selection



Item.GetInspector.WordEditor.Windows(1).Selection.PasteAndFormat wdPASTERTF 

RE: Bug When opening outlook to create a calendar entry

WordEditor property should return Word.Document object for the appointment item. There is a problem here. Any rules for the fault?
Try to add references to word and outlook, comment constants declarations (vba will take their values from referenced libraries), does the code still breaks?

combo

RE: Bug When opening outlook to create a calendar entry

(OP)
Hi Combo

I have added the references to MS Word 15.0 Object Library and MS Outlook 15.0 Object Library

I am seeing the following message

Run Time Error '-2147023170 (800706be)':
Automation Error
The remote procedure call failed.

Thanks

RE: Bug When opening outlook to create a calendar entry

Please post the testing code after all changes and references set.
Comment the line that generates error. Does the code create appointment item without pasted data?

combo

RE: Bug When opening outlook to create a calendar entry

(OP)
Hi Combo

Code is below with the highlighted line that generates the error
The code does create the appointment item without pasted data
Please note that the error seems to be generated every second time the code is run

Thanks


CODE -->

Sub option_explicit_CreateMeeting_Click()

Dim ol As Object
Dim Item As Object
Dim OutApp3 As Object
Const olAppointmentItem = 1

'item As AppointmentItem
Set ol = CreateObject("Outlook.Application")
Set Item = ol.CreateItem(olAppointmentItem)

StartDate = [C11]
StartTime = [E11]
EndDate = [G11]
EndTime = [I11]
TimingofWork = [K11]
BuildingofWork = [C13]
Title = [I13]
DetailedDescriptionofWorks = [C15]
ImplementationPlan = [F17]
Whatmonitoring = [F19]
Backoutplan = [F21]
TestPlan = [F23]
PostImplementationVerification = [F25]
ImpacttoSytemOutputsandUsers = [C27]
Otherifapplicable = [C29]
CRNumber = [J31]
    
'Set Start Date
Item.Start = StartDate + TimeValue("00:00")
'Set End Date
Item.End = EndDate + TimeValue("00:30")
'appointment subject
Item.Subject = Title & " - " & BuildingofWork
'location description
Item.Location = BuildingofWork
'body message
Worksheets("Drop Down and Pastes").Range("C2:D22").Copy
Item.Display

Dim oInspector As Object
Dim oWordEditor As Object
Dim oWindow As Object
Const wdPASTERTF As Long = 1
Set oInspector = Item.GetInspector
Set oWordEditor = oInspector.WordEditor
Set oWindow = oWordEditor.Windows(1)
MsgBox oWindow.Selection



Item.GetInspector.WordEditor.Windows(1).Selection.PasteAndFormat wdPASTERTF
 
Item.Recipients.Add ("CR Notification Group")
'set the busy status
Item.BusyStatus = olFree
'reminder before start
Item.ReminderMinutesBeforeStart = 15
'reminder activated
Item.ReminderSet = True
'duh! save the thing!
Item.Display
'garbage collection - kind of...
Set ol = Nothing
Set Item = Nothing
'return true
makeReminder = True

End Sub 

RE: Bug When opening outlook to create a calendar entry

What Office version do you have? Problems with WordEditor in 2007 and 2010 were reported (here and here). Outlook 2003 requires editor setting. In one of linked threads activation of Inspector solved the issue.
Try:

CODE -->

Set oInspector = Item.GetInspector
oInspector.Activate
Set oWordEditor = oInspector.WordEditor
oWordEditor.Windows(1).Selection.PasteAndFormat wdPASTERTF 
Do you still have an error in third line?

combo

RE: Bug When opening outlook to create a calendar entry

(OP)
Hi Combo

I am using MS Office 2013

I have copied your code and now getting an error on the highlighted code

The appointment is being created and then stops. Please note that this happens every second time I run the code

Thanks for your continued help

CODE -->

Dim oInspector As Object
Dim oWordEditor As Object
Dim oWindow As Object
Const wdPASTERTF As Long = 1
Set oInspector = Item.GetInspector
oInspector.Activate
Set oWordEditor = oInspector.WordEditor
oWordEditor.Windows(1).Selection.PasteAndFormat wdPASTERTF 

RE: Bug When opening outlook to create a calendar entry

For sanity change variable name Item to oItem (Item can be used in referenced libraries).

Similarly to your other post, do not create another Outlook when Outlook is already open. The code suggested in this post:
On Error Resume Next
Set OutApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If OutApp Is Nothing Then
' Outlook not open
Set OutApp = CreateObject("Outlook.Application")
End If


Test if oInspector exists:
Set oInspector = Item.GetInspector
MsgBox oInspector Is Nothing
oInspector.Activate


Explore "Locals" window after the code broke.

combo

RE: Bug When opening outlook to create a calendar entry

(OP)
Hi Combo

Thanks for your advice again which I will update and check

I thought I'd mention the following as I'm sure it will be important as I have just noticed this

If I minimize the appointment item after I have created it, I can create another appointment item with no issues. I have done this about 20 times with no problem

When I cancel the appointment item (and do not save changes) by clicking the red cross (top right) I get the issue the next time I try to create the appointment item

Hope this makes sense

Thanks



RE: Bug When opening outlook to create a calendar entry

First of all, you need a clean code and understand what you are doing:
1)
Sub option_explicit_CreateMeeting_Click()
If the "option_explicit" in a procedure name is a consequence of Andrzejek's tip in your other thread, it does nothing here. You need it at a top of module (as in example) and it refers to all its contents.
2)
Dim ol As Object
...
Dim OutApp3 As Object
...
Set ol = CreateObject("Outlook.Application")

You don't need OutApp3. You don't need new Outlook each time you run the code, so use current Outlook if it is open (so GetObject and, only if error, CreateObject).
3)
If you have references to Outlook and Word libraries, allow VBA to read their variables directly (as olAppointmentItem, wdPasteRTF, olFree, NB the last one not defined). In this case comment or delete variable definitions. To see their values, search Word or Outlook libraries.
4)
'duh! save the thing!
Item.Display
'garbage collection - kind of...
Set ol = Nothing
Set Item = Nothing

You don't save the item. Just display it again (as a couple of lines above). Next, VBA variables are reset, but you stay with appointment and Outlook open.

combo

RE: Bug When opening outlook to create a calendar entry

(OP)
Hi Combo

I've now set Option Explicit on all code and declared variables. I think I have made the other changes you suggested and still having the issue

The code stops at the highlighted line

Also to mention my earlier comment

It seems that there is no issue when I create the appointment and send, save or minimize. If I close / cancel the appointment and do not save changes then I get the issue the next time I run the code

I have opened the locals window but I'm really not sure what I am looking at. Sorry as I am still (and continually) learning.

My Code is below

CODE -->

Sub CreateCalendarSchedule2_Click()
'Declare Variables
Dim ol As Object
Dim oItem As Object
Dim StartDate As Date
Dim StartTime As String
Dim EndDate As Date
Dim EndTime As String
Dim TimingofWork As String
Dim BuildingofWork As String
Dim Title As String
Dim DetailedDescriptionofWorks As String
Dim ImplementationPlan As String
Dim Whatmonitoring As String
Dim Backoutplan As String
Dim TestPlan As String
Dim PostImplementationVerification As String
Dim ImpacttoSytemOutputsandUsers As String
Dim Otherifapplicable As String
Dim CRNumber As String
Dim makeReminder As String

'Check Outlook is Open and if not then open
Set ol = GetObject(, "Outlook.Application")
On Error GoTo 0
If ol Is Nothing Then
Set ol = CreateObject("Outlook.Application")
End If

'Capture Data From Excel
StartDate = [C11]
StartTime = [E11]
EndDate = [G11]
EndTime = [I11]
TimingofWork = [K11]
BuildingofWork = [C13]
Title = [I13]
DetailedDescriptionofWorks = [C15]
ImplementationPlan = [F17]
Whatmonitoring = [F19]
Backoutplan = [F21]
TestPlan = [F23]
PostImplementationVerification = [F25]
ImpacttoSytemOutputsandUsers = [C27]
Otherifapplicable = [C29]
CRNumber = [J31]

'Create Appointment Item
Set oItem = ol.CreateItem(olAppointmentItem)
'Set Start Date
oItem.Start = StartDate + TimeValue("00:00")
'Set End Date
oItem.End = EndDate + TimeValue("00:30")
'appointment subject
oItem.Subject = Title & " - " & BuildingofWork
'location description
oItem.Location = BuildingofWork
'body message
Worksheets("Drop Down and Pastes").Range("C2:D22").Copy
oItem.Display

'Paste Details to Appointment
Dim oInspector As Object
Dim oWordEditor As Object
Dim oWindow As Object
Set oInspector = oItem.GetInspector
oInspector.Activate
Set oWordEditor = oInspector.WordEditor
oWordEditor.Windows(1).Selection.PasteAndFormat wdPASTERTF

'Create Appointment Details
oItem.Recipients.Add ("CR Notification Group")
'set the busy status
oItem.BusyStatus = olFree
'reminder before start
oItem.ReminderMinutesBeforeStart = 15
'reminder activated
oItem.ReminderSet = True

'Display
oItem.Display

'Reset Variables
Set ol = Nothing
Set oItem = Nothing

End Sub 


RE: Bug When opening outlook to create a calendar entry

Tell vba to continue if no outlook is open (GetObject fails in this case):
'Check Outlook is Open and if not then open
On Error Resume Next
Set ol = GetObject(, "Outlook.Application")
On Error GoTo 0
If ol Is Nothing Then
    Set ol = CreateObject("Outlook.Application")
End If 
I assume that your vba project has reference to Outlook library. Probably you have no reference to Word - add it.
Start the code with open Outlook. Close Outlook and run it again. try with open Word.
Try without oInspector.Activate.
Examine oInspector Object in 'Locals' window, check child objects and variables.
Check Outlook settings, esp. editors set (if this can be set).

Currently I have no access to Outlook, I will be able to check it late next week.

combo

RE: Bug When opening outlook to create a calendar entry

(OP)
Thanks Combo

I will check and let you know

RE: Bug When opening outlook to create a calendar entry

(OP)
Hi Combo

I applied most of your suggested changes and still had an issue. I then spent some time changing the sequence of actions within the code and I am very please to say that I have run the code many times with no issues
Thanks so much for your patience and help
It really is appreciated

For reference the final code is below

CODE -->

Sub CreateCalendarSchedule_Click()
'Declare Variables
Dim ol As Object
Dim oItem As Object
Dim StartDate As Date
Dim StartTime As String
Dim EndDate As Date
Dim EndTime As String
Dim TimingofWork As String
Dim BuildingofWork As String
Dim Title As String
Dim DetailedDescriptionofWorks As String
Dim ImplementationPlan As String
Dim Whatmonitoring As String
Dim Backoutplan As String
Dim TestPlan As String
Dim PostImplementationVerification As String
Dim ImpacttoSytemOutputsandUsers As String
Dim Otherifapplicable As String
Dim CRNumber As String
Dim makeReminder As String

'Check Outlook is Open and if not then open
On Error Resume Next
Set ol = GetObject(, "Outlook.Application")
On Error GoTo 0
If ol Is Nothing Then
    Set ol = CreateObject("Outlook.Application")
End If

'Capture Data From Excel
StartDate = [C11]
StartTime = [E11]
EndDate = [G11]
EndTime = [I11]
TimingofWork = [K11]
BuildingofWork = [C13]
Title = [I13]
DetailedDescriptionofWorks = [C15]
ImplementationPlan = [F17]
Whatmonitoring = [F19]
Backoutplan = [F21]
TestPlan = [F23]
PostImplementationVerification = [F25]
ImpacttoSytemOutputsandUsers = [C27]
Otherifapplicable = [C29]
CRNumber = [J31]

'Create Appointment Item
Set oItem = ol.CreateItem(olAppointmentItem)
'Set Start Date
oItem.Start = StartDate + TimeValue("00:00")
'Set End Date
oItem.End = EndDate + TimeValue("00:30")
'appointment subject
oItem.Subject = Title & " - " & BuildingofWork
'location description
oItem.Location = BuildingofWork

'Display
oItem.Display

'Create Appointment Details
oItem.Recipients.Add ("CR Notification Group")
'set the busy status
oItem.BusyStatus = olFree
'reminder before start
oItem.ReminderMinutesBeforeStart = 15
'reminder activated
oItem.ReminderSet = True

'Paste Details to Appointment body message
Worksheets("Drop Down and Pastes").Range("C2:D22").Copy
Dim oInspector As Object
Dim oWordEditor As Object
Dim oWindow As Object
Set oInspector = oItem.GetInspector
'oInspector.Activate
Set oWordEditor = oInspector.WordEditor
oWordEditor.Windows(1).Selection.PasteAndFormat wdPASTERTF

'Reset Variables
Set ol = Nothing
Set oItem = Nothing

End Sub 

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close