Create Outlook Entries from Word Document

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

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, however the first step (required for all the macros on this page) is to add the Outlook object library to Word's vba. This can be located by running the vba editor (ALT+F11) and from Tools > References, check the Outlook entry. The illustration shows the version for Office 2003.

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

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:

Sub AddAppntmnt()
'Adds a list of events contained in a three column Word table
'with a header row, to Outlook Calendar
Dim ol As New Outlook.Application
Dim ci As AppointmentItem
Dim ctable As Table
Dim i As Long
Dim strStartDate As Range
Dim strEndDate As Range
Dim strSubject As Range

Set ctable = ActiveDocument.Tables(1)

'Ignore the first (header) row of the table
For i = 2 To ctable.Rows.Count

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.

Sub AddOutlookCont()
Dim ol As New Outlook.Application
Dim ci As ContactItem
Dim strAddress As String
Dim strName As String
Dim strFullName As String
Dim strBusiness As String
Dim iSplit As Integer
Dim iResult As Integer

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 GoTo UserCancelled:
'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 ci = ol.CreateItem(olContactItem)
ci.MailingAddress = strBusiness
ci.CompanyName = strName
If strFullName <> "" Then ci.FullName = strFullName
ci.FileAs = strName