Accessing OUTLOOK tasks from Word using VBA
'It is a macro written in VBA (copy the code into VBA macro module).
'Download all tasks in out look and format it into a table
Sub DownloadTasks()
Dim wordApp As Words
'Dim objTask As TaskItem
Dim myTaskFolder As MAPIFolder
Set objApp = CreateObject("Outlook.Application")
Set objTask = objApp.CreateItem(olTaskItem)
Set myTaskFolder = objApp.GetNamespace("MAPI").GetDefaultFolder(olFolderTasks)
Count = myTaskFolder.Items.Count
'Task = myTaskFolder.Items.GetFirst
Set wodDoc = ActiveDocument
wodDoc.Content = ""
Dim myItem As Object
Set myItems = myTaskFolder.Items
Set myRange = wodDoc.Content
myRange.InsertAfter "Task Name" & ": " & "Due Date" & ": " & "Start Date"
wodDoc.Content.InsertParagraphAfter
'display all tasks
For Each myItem In myItems
Set myRange = wodDoc.Content
myRange.InsertAfter myItem & ": " & myItem.DueDate & ": " & myItem.StartDate
wodDoc.Content.InsertParagraphAfter
Next
Call Format
____________________________________________________________________
End Sub
'format the downloaded tasks to a table
Sub Format()
Selection.WholeStory
Selection.ConvertToTable Separator:=wdSeparateByDefaultListSeparator, _
AutoFitBehavior:=wdAutoFitContent
With Selection.Tables(1)
.Style = "Table Grid"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
End Sub
'Download all tasks in out look and format it into a table
Sub DownloadTasks()
Dim wordApp As Words
'Dim objTask As TaskItem
Dim myTaskFolder As MAPIFolder
Set objApp = CreateObject("Outlook.Application")
Set objTask = objApp.CreateItem(olTaskItem)
Set myTaskFolder = objApp.GetNamespace("MAPI").GetDefaultFolder(olFolderTasks)
Count = myTaskFolder.Items.Count
'Task = myTaskFolder.Items.GetFirst
Set wodDoc = ActiveDocument
wodDoc.Content = ""
Dim myItem As Object
Set myItems = myTaskFolder.Items
Set myRange = wodDoc.Content
myRange.InsertAfter "Task Name" & ": " & "Due Date" & ": " & "Start Date"
wodDoc.Content.InsertParagraphAfter
'display all tasks
For Each myItem In myItems
Set myRange = wodDoc.Content
myRange.InsertAfter myItem & ": " & myItem.DueDate & ": " & myItem.StartDate
wodDoc.Content.InsertParagraphAfter
Next
Call Format
____________________________________________________________________
End Sub
'format the downloaded tasks to a table
Sub Format()
Selection.WholeStory
Selection.ConvertToTable Separator:=wdSeparateByDefaultListSeparator, _
AutoFitBehavior:=wdAutoFitContent
With Selection.Tables(1)
.Style = "Table Grid"
.ApplyStyleHeadingRows = True
.ApplyStyleLastRow = True
.ApplyStyleFirstColumn = True
.ApplyStyleLastColumn = True
End With
End Sub


0 Comments:
Post a Comment
<< Home