Create Outlook Entries from Word

Many people access the material from this web site daily. Most just take what they want and run. That's OK, provided they are not selling on the material as their own; however if your productivity gains from the material you have used, a donation from the money you have saved would help to ensure the continued availability of this resource. Click the appropriate button above to access PayPal.

Create Outlook entries from a Word document

If you do not know what to do with macro code listings, see my Idiots Guide to Installing Macros.

In the first example you may have a list of events that you wish to insert into Outlook's calendar. This is relatively simple to do using a Word table to store the list..

The macro assumes that the currently active document is a list of events contained in a three column table with a header row, similar to the example below:

The macro enters each entry in the table (apart from the header row) into Outlook's Calendar and assigns the Category 'Events'.

Note that the macros below use Late Binding to the Outlook object library. This enables calls to be made to Outlook VBA code functions without setting a reference to the Outlook object library in Word's VBA editor.

Sub AddAppntmnt()
'Adds a list of events contained in a three column Word table
'with a header row, to Outlook Calendar
Dim olApp As Object
Dim olItem As Object
Dim oTable As Table
Dim i As Long
Dim bStarted As Boolean
Dim strStartDate As Range
Dim strEndDate As Range
Dim strSubject As Range
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set olApp = CreateObject("Outlook.Application")
bStarted = True
End If
Set oTable = ActiveDocument.Tables(1)

'Ignore the first (header) row of the table
For i = 2 To oTable.Rows.Count
Set strStartDate = oTable.Cell(i, 1).Range
strStartDate.End = strStartDate.End - 1
Set strEndDate = oTable.Cell(i, 2).Range
strEndDate.End = strEndDate.End - 1
Set strSubject = oTable.Cell(i, 3).Range
strSubject.End = strSubject.End - 1
Set olItem = olApp.CreateItem(1)
olItem.Start = strStartDate
olItem.End = strEndDate
olItem.ReminderSet = False
olItem.AllDayEvent = True
olItem.Subject = strSubject
olItem.Categories = "Events"
olItem.BusyStatus = 0
olItem.Save
Next i
If bStarted Then olApp.Quit
Set olApp = Nothing
Set olItem = Nothing
Set oTable = Nothing
End Sub

Add Outlook Task from Word Document

The next example adds a task reminder based on the current document to follow up the document in 10 days with a due date of 14 days. The macro prompts for a category to assign:

Sub AddOutlookTask()
Dim olApp As Object
Dim olItem As Object
Dim bStarted As Boolean
Dim fName As String
Dim flName As String
On Error Resume Next
If ActiveDocument.Saved = False Then
ActiveDocument.Save
If Err.Number = 4198 Then
MsgBox "Process ending - document not saved!"
GoTo UserCancelled:
End If
End If
Set olApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
'Outlook wasn't running, start it from code
Set olApp = CreateObject("Outlook.Application")
bStarted = True
End If
Set olItem = olApp.CreateItem(3) 'Task Item
fName = ActiveDocument.name
flName = ActiveDocument.FullName
olItem.Subject = "Follow up " & fName
olItem.Body = "If no reply to" & vbCr & _
flName & vbCr & "further action required"
olItem.StartDate = Date + 10 '10 days from today
olItem.DueDate = Date + 14 '14 days from today
olItem.Importance = 2 'High
olItem.Categories = InputBox("Category?", "Categories")
olItem.Save
UserCancelled:
If bStarted Then olApp.Quit
Set olApp = Nothing
Set olItem = Nothing
End Sub

Add Addressee information from a letter to Outlook Contacts

Word provides the means to look up Outlook Contacts to add to the addresses to documents, and an enhanced version of this can be found on the Macrobutton tutorial page, but what if you want to reverse the process and save a typed address back into Outlook as a new contact? The following macro performs that task.

As configured it creates a new business contact. In addition to the company address which the user first selects from the document, an input box asks for the personal contact name (if any). A second input box is provided for category information.

Sub AddOutlookCont()
Dim olApp As Object
Dim olItem As Object
Dim bStarted As Boolean
Dim strAddress As String
Dim strName As String
Dim strFullName As String
Dim strBusiness As String
Dim iSplit As Long
Dim iResult As Long
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
'Outlook wasn't running, start it from code
Set olApp = CreateObject("Outlook.Application")
bStarted = True
End If
On Error GoTo 0
strAddress = Selection.Range
'error check to establish if an address has been selected
If Len(strAddress) < 1 Then
MsgBox "No address selected!" & vbCr & _
"Select the address and re-run the macro", _
vbCritical, _
"Select Address"
Exit Sub
End If
'Let the user see the selected address is correct
iResult = MsgBox("Is the address correct?" & _
vbCr & vbCr & strAddress, vbYesNo, "Address")
If iResult = 7 Then
MsgBox "User Cancelled or address not selected"
GoTo UserCancelled:
End If
'Prompt for personal contact details, if known
strFullName = InputBox("Enter contact's full name if known" _
& vbCr & "in the format 'Mr. John Smith", _
"Contact name")
On Error GoTo UserCancelled:
iSplit = InStr(strAddress, Chr(13))
strName = Left(strAddress, iSplit - 1)
strBusiness = Right(strAddress, (Len(strAddress) - Len(strName)))
Set olItem = olApp.CreateItem(2) 'Contact Item
olItem.MailingAddress = strBusiness
olItem.CompanyName = strName
If strFullName <> "" Then olItem.FullName = strFullName
olItem.FileAs = strName
'Prompt for category
olItem.Categories = InputBox("Category?", "Categories")
olItem.Save
UserCancelled:
If bStarted Then olApp.Quit
Set olApp = Nothing
Set olItem = Nothing
End Sub

Outlook from Word

Word users can use the power of Word and vba to create entries in Outlook based upon the content of a Word document.

Graham Mayor