Use Excel Date to create Outlook Appointment
First post here, so I'll try to be thorough in my explanation. I have an Excel spreadsheet where a person enters a book title and a due date. I need to take that due date & title from XL to a reminder in Outlook. I've found lots of VB macros to do that, my problem is that the user will be entering dates all the time and I want her to be able to execute the macro for each entry that she makes. In other words, I need the macro to execute based on the current cell position. I've written macros before, but it seems like everything I know is not working in this particular instance!
In A2, I might have the name of a book and in B2 the date it is to be returned. I want her to be able to execute a macro with her cell pointer sitting in B2 that will pick up the name of the book and the due date and put a reminder on her Outlook calendar. Tomorrow if someone else borrows a book and she enters that information into A3 and B3, again I want her to be able to execute that macro from B3 to pick up those to entries and make a reminder in Outlook.
Any help anyone can provide is much appreciated!!
Create Outlook Appointment/Task
Call the AddToTasks function with the required parameters from the below code snippet as per you requirement...
Function AddToTasks(TaskDate As Date, TaskSubject As String) As Boolean
Dim olApp As Object ' Outlook.Application
Dim objTask As Object ' Outlook.TaskItem
On Error Resume Next
Set olApp = GetOutlookApp
On Error GoTo 0
If Not olApp Is Nothing Then
Set objTask = olApp.CreateItem(3) ' task item
With objTask
.StartDate = TaskDate
.Subject = TaskSubject & ", due on: " & Format(TaskDate, "dd-mmm-yyyy")
.ReminderSet = True
.Save
End With
Else
AddToTasks = False
GoTo ExitProc
End If
AddToTasks = True
ExitProc:
olApp.Quit
Set olApp = Nothing
Set objTask = Nothing
End Function
Function GetOutlookApp() As Object
On Error Resume Next
Set GetOutlookApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Set GetOutlookApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
End Function