Code to open a new appointment

J

james_IT

Registered User.
Local time
Today, 11:33
Joined
Jul 5, 2006
Messages
208
Hi guys

I have seen various threads about setting an outlook reminder based on an appt table and then a form. All i want to do is have a command button which opens outlook and opens a new appointment in the calendar for the user to enter the reminder information themselves.

Is this possible?

I have the code below to open outlook but it opens a new copy of outlook (even if outlook is already open) and i dont know how to open the calendar or new appointment...

Code: 
Private Sub Command69_Click()
On Error GoTo Err_Command69_Click

    Dim stAppName As String

    stAppName = "C:\Program Files\Microsoft Office\OFFICE11\OUTLOOK.EXE"
    Call Shell(stAppName, 1)

Exit_Command69_Click:
    Exit Sub

Err_Command69_Click:
    MsgBox Err.Description
    Resume Exit_Command69_Click
    
End Sub

So to summarise, i do not want to automate an appointment with another form, just open the window for the user to enter it directly to outlook...

TIA
 
Here is the code to open the outlook calendar. You will have to set the reference to Outlook in the VBA screen, so use Alt + F11 and then goto the Tools menu look down the list until you find Microsoft Outlook a number .object library, place a tick in the box and click Ok..

Sub ShowCalendar()

Dim mOutlookApp As Outlook.Application
Dim mNameSpace As Outlook.Namespace
Set mOutlookApp = New Outlook.Application
Set mNameSpace = mOutlookApp.GetNamespace("MAPI")
mNameSpace.GetDefaultFolder(olFolderCalendar).Display
Set mNameSpace = Nothing
Set mOutlookApp = Nothing
End Sub
Click to expand...
 
Trevor G said:
Here is the code to open the outlook calendar. You will have to set the reference to Outlook in the VBA screen, so use Alt + F11 and then goto the Tools menu look down the list until you find Microsoft Outlook a number .object library, place a tick in the box and click Ok..
Click to expand...

thanks trevor, that works great to open the calendar. a couple of things -

firslty it still opens a new version of outlook - not the existing one (all users have their outlook open and minimised all day). im not sure if this can be helped?

secondly - is there a further step to open a new untitled appointment?

lastly - it always opens in a restored window, not maxmised - is there a way to change this default?
 
james_IT said:
thanks trevor, i tried it but cant seem to get it to work - can it just be placed in the on click event of a command button?
Click to expand...


Yes just copy the code below into the on click event, don't forget to set the Reference

Dim mOutlookApp As Outlook.Application
Dim mNameSpace As Outlook.Namespace
Set mOutlookApp = New Outlook.Application
Set mNameSpace = mOutlookApp.GetNamespace("MAPI")
mNameSpace.GetDefaultFolder(olFolderCalendar).Disp lay
Set mNameSpace = Nothing
Set mOutlookApp = Nothing
Click to expand...
 
Trevor G said:
Yes just copy the code below into the on click event, don't forget to set the Reference
Click to expand...

sorry trevor, i edited my post when i got it working before you replied...

firstly it still opens a new version of outlook - not the existing one (all users have their outlook open and minimised all day). im not sure if this can be helped?

secondly - is there a further step to open a new untitled appointment?

lastly - it always opens in a restored window, not maxmised - is there a way to change this default?
 
James,

You would need to do something like this to create the appointment

Dim Appt As Outlook.AppointmentItem
Set Appt = OlApp.CreateItem(olAppointmentItem)


I don't the commands to switch a window on the pc and use the Outlook Maximise commands. I think you would need to look at using some calling API commands.

But you should be able to find examples on Google
 
Trevor G said:
James,

You would need to do something like this to create the appointment

Dim Appt As Outlook.AppointmentItem
Set Appt = OlApp.CreateItem(olAppointmentItem)


I don't the commands to switch a window on the pc and use the Outlook Maximise commands. I think you would need to look at using some calling API commands.

But you should be able to find examples on Google
Click to expand...

thanks again trevor

im not overly concerned about the maxmise thing just curious.

with regards to opening a new appointment i cant seem to get this to work where ever i try it in the code... it opens the calendar but not a new appointment window...

Code: 
Private Sub Command69_Click()

Dim mOutlookApp As Outlook.Application
Dim mNameSpace As Outlook.NameSpace
Dim olApp As Outlook.Application
Set olApp = CreateObject("Outlook.Application")
Set mOutlookApp = Outlook.Application
Set mNameSpace = mOutlookApp.GetNamespace("MAPI")
mNameSpace.GetDefaultFolder(olFolderCalendar).Display
Set mNameSpace = Nothing
Set mOutlookApp = Nothing
Dim Appt As Outlook.AppointmentItem
Set Appt = olApp.CreateItem(olAppointmentItem)

End Sub
 
firstly it still opens a new version of outlook - not the existing one (all users have their outlook open and minimised all day). im not sure if this can be helped?
Click to expand...

To use existing Outlook use:

Set olApp = GetObject(, "Outlook.Application")

However you need to trapp an error if for some reason one of you users don't have outlook open.

Code: 
Dim mOutlookApp As Outlook.Application
Dim mNameSpace As Outlook.NameSpace
Dim olApp As Outlook.Application
 
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
 
If Err.Number = 429 Then
     Err.Clear
      'Outlook is not running; open Outlook with CreateObject
      Set olApp = CreateObject("Outlook.Application")
End If
..
... rest of your code

JR
 
JANR said:
To use existing Outlook use:

Set olApp = GetObject(, "Outlook.Application")

However you need to trapp an error if for some reason one of you users don't have outlook open.

Code: 
Dim mOutlookApp As Outlook.Application
Dim mNameSpace As Outlook.NameSpace
Dim olApp As Outlook.Application
 
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
 
If Err.Number = 429 Then
     Err.Clear
      'Outlook is not running; open Outlook with CreateObject
      Set olApp = CreateObject("Outlook.Application")
End If
..
... rest of your code

JR
Click to expand...

Thanks JR. tried the code below but now the command button doesnt do anything!

Code: 
Private Sub Command69_Click()

Dim mOutlookApp As Outlook.Application
Dim mNameSpace As Outlook.NameSpace
Dim olApp As Outlook.Application
 
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
 
If Err.Number = 429 Then
     Err.Clear
      'Outlook is not running; open Outlook with CreateObject
      Set olApp = CreateObject("Outlook.Application")
End If

Dim Appt As Outlook.AppointmentItem
Set mNameSpace = mOutlookApp.GetNamespace("MAPI")
mNameSpace.GetDefaultFolder(olFolderCalendar).Display
Set Appt = olApp.CreateItem(olAppointmentItem)

Set mNameSpace = Nothing
Set mOutlookApp = Nothing

End Sub
 
I'm no expert on outlook automation, the codesnippet was only to get control over outlook.

The rest of you code is probably where it breaks, perhaps some other will jump on and help you with that.

JR
 
The default for all Office programs is not visible. If the user does not have outlook open and you initiate it for him there are two things you will have to do. 1. you will have to close it after you are finished. 2. you will have to make your Appt object visible.
 
by the way you need to set each object of outlooks to nothing otherwise outlook will not close properly. You also need to set the Outlook Application object to nothing Last.
 
This works.

For earlybinding:
Code: 
Function testOut()
Dim olApp As Outlook.Application
Dim mNameSpace As Outlook.Namespace
 
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
 
If Err.Number = 429 Then
     Err.Clear
      'Outlook is not running; open Outlook with CreateObject
      Set olApp = CreateObject("Outlook.Application")
End If
 
Set mNameSpace = olApp.GetNamespace("MAPI")
mNameSpace.GetDefaultFolder(olFolderCalendar).Display
 
Dim olApt As AppointmentItem
Set olApt = olApp.CreateItem(olAppointmentItem)
olApt.Display
 
Set olApt = Nothing
Set mNameSpace = Nothing
Set olApp = Nothing
End Function


Need some error handling thou. :)

JR
 
Last edited:
Late Binding Option:

Code: 
Function GetOutlook()
' Late Binding Outlook
' [URL]http://msdn.microsoft.com/en-us/library/aa219371(office.11).aspx[/URL]  <- List of constants in outlook
Dim olApp As Object
Dim mNameSpace As Object
 
Const olFolderCalendar = 9
Const olAppointmentItem = 1
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
 
If Err.Number = 429 Then
     Err.Clear
      'Outlook is not running; open Outlook with CreateObject
      Set olApp = CreateObject("Outlook.Application")
End If
 
Set mNameSpace = olApp.GetNamespace("MAPI")
mNameSpace.GetDefaultFolder(olFolderCalendar).Display
 
Dim olApt As Object
Set olApt = olApp.CreateItem(olAppointmentItem)
olApt.Display
 
Set olApt = Nothing
Set mNameSpace = Nothing
Set olApp = Nothing
End Function

JR
 
you probably do not need this
Code: 
mNameSpace.GetDefaultFolder(olFolderCalendar).Display

You can display the AppointmentItem without the main application being visible.
 
Thats true, the code opens 2 separate objects as per James IT request in post #7.

I would leeve it out if the exersize is to only add an appointment to a useres outlook application.

JR
 
You must log in or register to reply here.

Similar threads

A
Solved VBA code for deleting Outlook 'Appointments' lying within a specified date range
Replies
8
Views
896
Gasman
Gasman
N
Solved MS Access Outlook VBA fixing
Replies
5
Views
204
nector
N
J
VBA Code to Email using the Free Version of the Outlook App.
Replies
12
Views
346
Gasman
Gasman
Jason Lee Hayes
Solved Open Outlook & check for new mail where search criteria is applied to the email subject line
Replies
19
Views
1,040
Jason Lee Hayes
Jason Lee Hayes
S
How to Open Outlook Classic from website email address?
Replies
15
Views
1,595
Gasman
Gasman

Users who are viewing this thread

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