Option Explicit
'Behind ThisOutlookSession
'Add a reference to MS Excel xx.0 Object Library
Public WithEvents oMnuExport As Office.CommandBarButton
Public WithEvents oTbbExport As Office.CommandBarButton
Private dStartDate As Date
Private dEndDate As Date
Private bCancelExport As Boolean
Private bExportAll As Boolean
Public Property Let StartDate(ByVal sDate As Date)
dStartDate = sDate
End Property
Public Property Get StartDate() As Date
StartDate = dStartDate
End Property
Public Property Let EndDate(ByVal sDate As Date)
dEndDate = sDate
End Property
Public Property Get EndDate() As Date
EndDate = dEndDate
End Property
Public Property Let ExportAll(ByVal bTrue As Boolean)
bExportAll = bTrue
End Property
Public Property Get ExportAll() As Boolean
ExportAll = bExportAll
End Property
Public Property Let CancelExport(ByVal bCancel As Boolean)
bCancelExport = bCancel
End Property
Private Sub oTbbExport_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
'invoke the "Export Public Tasks" menu item from our toolbar button click event
oMnuExport_Click Ctrl, CancelDefault
End Sub
Private Sub oMnuExport_Click(ByVal Ctrl As Office.CommandBarButton, CancelDefault As Boolean)
'\\Public Folders\All Public Folders\Arbitron\RSS\DTXARB\Western Div Projects
Dim oWestern As Outlook.MAPIFolder
Dim oTask As Outlook.TaskItem
Dim oItems As Outlook.Items
Dim oApp As Excel.Application
Dim oWB As Excel.Workbook
Dim oSht As Excel.Worksheet
Dim sSQL As String
Dim o As Long
Dim lHwnd As Long
'Show our date picker userform
UserForm1.Show vbModal
'Check if Cancel was pressed on date picker form.
If bCancelExport = True Then
Exit Sub
End If
UserForm1.MousePointer = fmMousePointerHourGlass
'Navigate to the source folder and set out object variable to it.
'Uncomment for when your at work.
'Set oWestern = Application.GetNamespace("MAPI").Folders("Public Folders").Folders("All Public Folders").Folders("Arbitron").Folders("RSS").Folders("DTXARB").Folders("Western Div Projects")
'For home testing on default task folder.
Set oWestern = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderTasks)
'We are now connected to our source folder
'Create an instance of Excel for automation
Set oApp = New Excel.Application
'Add a new blank workbook to the collection
Set oWB = oApp.Workbooks.Add
oApp.Columns.WrapText = False
'Initialize an object variable to the first sheet
Set oSht = oWB.Sheets(1)
'Setup column headers
oSht.Cells(1, 1).Font.Bold = True
oSht.Cells(1, 1).Value = "StartDate"
oSht.Cells(1, 2).Font.Bold = True
oSht.Cells(1, 2).Value = "CreationTime"
oSht.Cells(1, 3).Font.Bold = True
oSht.Cells(1, 3).Value = "Importance"
oSht.Cells(1, 4).Font.Bold = True
oSht.Cells(1, 4).Value = "Subject"
oSht.Cells(1, 5).Font.Bold = True
oSht.Cells(1, 5).Value = "Body"
oSht.Cells(1, 6).Font.Bold = True
oSht.Cells(1, 6).Value = "AdditionalText"
oSht.Cells(1, 7).Font.Bold = True
oSht.Cells(1, 7).Value = "CallsGroup"
'Filter the items in the desired folder by start date and / or Created
'writting the task data out to Excel
'Also, if the export all is checked then we will want to run a different sql statement filter.
If ExportAll = False Then
'Take a filtered range
sSQL = "(([Start] >= '" & StartDate & " 12:00 AM') AND ([Start] < '" & DateAdd("d", 1, EndDate) & " 12:00 AM'))"
sSQL = sSQL & " OR "
sSQL = sSQL & "(([Created] >= '" & StartDate & " 12:00 AM') AND ([Created] < '" & DateAdd("d", 1, EndDate) & " 12:00 AM'))"
Set oItems = oWestern.Items.Restrict(sSQL)
oItems.Sort "[Start]", False
Else
'Take all items in the folders collection of items.
Set oItems = oWestern.Items
oItems.Sort "[Created]", False
End If
UserForm1.prbProgress.Max = IIf(oItems.Count = 0, 1, oItems.Count)
For o = 1 To oItems.Count
If o = 1 Then
Set oTask = oItems.GetFirst
Else
Set oTask = oItems.GetNext
End If
oSht.Cells(o + 1, 1).Value = IIf(DateDiff("yyyy", #1/1/1900#, oTask.StartDate) > 100, "None", oTask.StartDate)
oSht.Cells(o + 1, 2).Value = oTask.CreationTime
oSht.Cells(o + 1, 3).Value = IIf(oTask.Importance = olImportanceHigh, "ImportanceHigh", IIf(oTask.Importance = olImportanceLow, "ImportanceLow", "ImportanceNormal"))
oSht.Cells(o + 1, 4).Value = oTask.Subject
oSht.Cells(o + 1, 5).Value = oTask.Body
'Commented for testing at home...
' oSht.Cells(o + 1, 6).Value = oTask.UserProperties.Item("AdditionalText").Value
' oSht.Cells(o + 1, 7).Value = oTask.UserProperties.Item("CallsGroup").Value
DoEvents
UserForm1.prbProgress.Value = UserForm1.prbProgress.Value + 1
Next
oApp.Columns("E:E").ColumnWidth = 100
oApp.Columns.WrapText = True
oApp.Columns.AutoFit
oApp.Rows.AutoFit
MsgBox "Done Exporting (" & oItems.Count & ") Public Task(s) to Excel!", vbOKOnly + vbInformation
oApp.Visible = True
UserForm1.MousePointer = fmMousePointerDefault
Unload UserForm1
Set oSht = Nothing
Set oWB = Nothing
Set oApp = Nothing
End Sub
Private Sub SyncMnuExportButton(btn As Office.CommandBarButton)
'Sync up the event to the object variable
Set oMnuExport = btn
If btn Is Nothing Then
MsgBox "Sync. of '" & btn.Caption & "' button event failed!", vbCritical + vbOKOnly
End If
End Sub
Private Sub SyncTbbExportButton(btn As Office.CommandBarButton)
'Sync up the event to the object variable
Set oTbbExport = btn
If btn Is Nothing Then
MsgBox "Sync. of '" & btn.Caption & "' button event failed!", vbCritical + vbOKOnly
End If
End Sub
Private Sub Application_MAPILogonComplete()
'Setup and add a new menu item to the Tools menu to enable us to invoke our custom Export method
Dim oCBmnuTools As Office.CommandBarPopup
Dim oCBmnuExport As Office.CommandBarButton
Dim oCBtbbStd As Office.CommandBar
Dim oCBtbbExport As Office.CommandBarButton
'Add a menu item if its not already there
Set oCBmnuTools = Application.ActiveExplorer.CommandBars("Menu Bar").Controls("&Tools")
Set oCBmnuExport = Application.ActiveExplorer.CommandBars("Menu Bar").FindControl(msoControlButton, 1, "888", True, True)
If TypeName(oCBmnuExport) = "Nothing" Then
Set oCBmnuExport = oCBmnuTools.Controls.Add(msoControlButton, 1, "888", , True)
End If
With oCBmnuExport
.BeginGroup = True
.Caption = "Export Public Tasks"
.Enabled = True
.Style = msoControlCustom
.Tag = "888"
.Visible = True
End With
Call SyncMnuExportButton(oCBmnuExport)
'Add the toolbar button
Set oCBtbbStd = Application.ActiveExplorer.CommandBars("Standard")
Set oCBtbbExport = oCBtbbStd.FindControl(msoControlButton, 1, "889", True, True)
If TypeName(oCBtbbExport) = "Nothing" Then
Set oCBtbbExport = oCBtbbStd.Controls.Add(msoControlButton, 1, "888", , True)
End If
With oCBtbbExport
.BeginGroup = True
.Caption = "Export Public Tasks"
.Enabled = True
.FaceId = 263 'Excel Icon
'Option: Use icon only
'.Style = msoButtonIcon
'Option: Use icon and text
.Style = msoButtonIconAndCaption
.TooltipText = "Export Public Tasks to a new Excel Workbook"
.Tag = "889"
.Visible = True
End With
Call SyncTbbExportButton(oCBtbbExport)
End Sub
