VBA

My Photo
Name:
Location: Hyderabad, Andhra Pradesh, India

Software Engineer , professional expertise in J2ee

Wednesday, July 27, 2005

Accessing OUTLOOK Unread mails from Word using VBA

'Download all Unread mails from outlook to word and format it into a table
'Make sure Outlook reference added.( tools -> references -> Microsoft outlook)
Sub DownloadMails()
Dim wordApp As Words
Dim myMailFolder As MAPIFolder
'Creating outlook appliction
Set objApp = CreateObject("Outlook.Application")
'Getting outlook inbox folder
Set myMailFolder = objApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
'Total number of mails in the inbox
Count = myMailFolder.Items.Count

Set wodDoc = ActiveDocument
wodDoc.Content = ""

Set myRange = wodDoc.Content

'display all Unreaded mails
i = 0
While i < Count
i = i + 1
With myMailFolder.Items(i)
If (.UnRead) Then
myRange.InsertAfter .Subject & "|" & .ReceivedTime & "|" & .SenderName & "|" & .SenderEmailAddress
wodDoc.Content.InsertParagraphAfter
myRange.InsertAfter "---------------------------------------------------------------------------------------------"
wodDoc.Content.InsertParagraphAfter
myRange.InsertAfter .Body
wodDoc.Content.InsertParagraphAfter
myRange.InsertAfter "---------------------------------------END OF THE MESSAGE------------------------------------"
wodDoc.Content.InsertParagraphAfter
End If
End With
Wend

End Sub

Tuesday, July 26, 2005

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