If you’re a Microsoft Outlook Journal user, save this code into a macro to export journal entries from a select time range into Excel.
Updated for Excel 2007. In your macro window, under Tools>References, make sure you check the Microsoft Excel 12 Object Library and Microsoft Access 12 Object Library.
Sub exportjournal()
''
''Created 4/4/08
''Source: Programming Microsoft Outlook 2000 by Ken Slovak
''Had to add references to Microsoft Excel 11 and Access (for the Nz function)
'' also see http://msdn.microsoft.com/archive/default.asp?url=/archive/en-us/dnaro97ta/html/sampauto.asp
''Works!
Const strNone As String = "No journal items."
Const strTitle As String = "Export"
Dim appOL As Outlook.Application
Dim nmsNS As Outlook.NameSpace
Dim fldFolder As Outlook.MAPIFolder
Dim itmItems As Outlook.Items
Dim itmJournal As Outlook.JournalItem
Dim appExcel As Excel.Application
Dim wbkBook As Excel.Workbook
Dim wrkSheet As Excel.Worksheet
Dim rngRange As Excel.Range
Dim lngCount As Long
Dim intReturn As Integer
Dim intRow As Integer
Dim strRange As String
Dim strWorkBook As String
Dim strUNI As String
Dim begindate As Date
'Set a reference to the default Journal folder
Set appOL = CreateObject("Outlook.Application")
Set nmsNS = appOL.GetNamespace("MAPI")
Set fldFolder = nmsNS.GetDefaultFolder(olFolderJournal)
Set itmItems = fldFolder.Items
lngCount = itmItems.Count
If lngCount = 0 Then
intReturn = MsgBox(strNone, , strTitle)
Exit Sub
End If
'Get date from user
begindate = InputBox("Enter Begin Date")
EndDate = InputBox("Enter End Date")
strWorkBook = "C:\foldername\JournalExport.xls"
'Initialize Excel items
Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open (strWorkBook)
'Activate Sheet 1
Set wrkSheet = appExcel.ActiveWorkbook.Sheets(1)
wrkSheet.Activate
appExcel.Visible = True
'Set Sheet column widths
wrkSheet.Columns("A").ColumnWidth = 20
wrkSheet.Columns("B").ColumnWidth = 20
wrkSheet.Columns("C").ColumnWidth = 16
wrkSheet.Columns("D").ColumnWidth = 20
wrkSheet.Columns("E").ColumnWidth = 50
'The example in the book
'has a bunch of formatting code that I am ignoring
'Start adding data at Column A, Row 1
intRow = 1
strUNI = "A"
For Each itmJournal In itmItems
With itmJournal
'adjust date as needed
'If itmJournal.LastModificationTime > begindate And itmJournal.LastModificationTime < EndDate Then If itmJournal.Start > begindate And itmJournal.Start < EndDate Then
'Subject
strRange = strUNI & CStr(intRow)
Set rngRange = wrkSheet.Range(strRange)
rngRange.Value = nz(.Subject)
'start time
strUNI = Chr(Asc(strUNI) + 1)
strRange = strUNI & CStr(intRow)
Set rngRange = wrkSheet.Range(strRange)
rngRange.Value = nz(.Start)
'Duration
strUNI = Chr(Asc(strUNI) + 1)
strRange = strUNI & CStr(intRow)
Set rngRange = wrkSheet.Range(strRange)
rngRange.Value = nz(.Duration)
'Categories
strUNI = Chr(Asc(strUNI) + 1)
strRange = strUNI & CStr(intRow)
Set rngRange = wrkSheet.Range(strRange)
rngRange.Value = nz(.Categories)
'Notes = body(?)
strUNI = Chr(Asc(strUNI) + 1)
strRange = strUNI & CStr(intRow)
Set rngRange = wrkSheet.Range(strRange)
rngRange.Value = nz(.Body)
'Back to column A, next row
strUNI = "A"
intRow = intRow + 1
End If
End With
Next itmJournal
Exit Sub
ExportJournal_Error:
MsgBox "Error #" & Err.Number & Err.Description
End Sub
