PDA

View Full Version : Create Outlook Task from VBA in Word



mklindquist
10-23-2013, 10:53 AM
Has anyone created an outlook task from VBA behind a button in MS Word? I'm creating a query request for my users to fill out and when they click on a button I want it to create a task in outlook in my name. I want to use fields that are on the form to fill the required task fields.

I wonder if anyone has some examples that I can start with.

Thanks!

Maria

gmaxey
10-24-2013, 07:54 AM
This may help get you started. User your command button click event to pass parameters to one of these functions.


Option Explicit
Public Function fcnCreateCalEvent(ByRef strEvent As String, oDateEvent As Date) As Boolean
Dim oOutlookApp As Object 'Outlook.Application
Dim oCalEvent As Object
On Error Resume Next
'Start Outlook if it isn't running
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
Set oCalEvent = oOutlookApp.CreateItem(1)
With oCalEvent
.Start = oDateEvent
.Subject = strEvent
.ReminderSet = True
.BusyStatus = 0 '2 'olFree
.AllDayEvent = True
End With
oCalEvent.Display
Set oCalEvent = Nothing
Set oOutlookApp = Nothing
fcnCreateCalEvent = (Err.Number = 0)
On Error GoTo 0
lbl_Exit:
Exit Function
End Function
Public Function fcnCreateTask(ByRef strEvent As String, oStartDate As Date, oDateEvent As Date) As Boolean
Dim oOutlookApp As Object 'Outlook.Application
Dim oTask As Object 'Outlook.TaskItem
Dim oReminderTime As Date
On Error Resume Next
'Start Outlook if it isn't running
Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
Set oTask = oOutlookApp.CreateItem(3) 'olTaskItem
oReminderTime = DateAdd("d", -3, oDateEvent)
oReminderTime = DateAdd("h", 9, oReminderTime)
With oTask
.StartDate = oStartDate
.DueDate = oDateEvent
.Subject = strEvent
.ReminderSet = True
.ReminderTime = oReminderTime
End With
oTask.Display
Set oTask = Nothing
Set oOutlookApp = Nothing
fcnCreateTask = (Err.Number = 0)
On Error GoTo 0
lbl_Exit:
Exit Function
End Function