Excel Tool to fetch data from OUTLOOK Folder

Excel Tool to fetch data from OUTLOOK Folder

Tutorial – Excel Tool to fetch data from OUTLOOK Folder. This is an excel VBA tool; this tool fetches the INBOX data from Outlook folder.

You can select the FOLDER- from which folder you want to retrieve the emails. Its code module is very useful in day- 2 – day reporting. All of the VBA functions are generic in nature and can be used in other excel vba tools and for learning purpose.

Excel Tool to fetch data from OUTLOOK Folder

Below is the code module to fetch the records ( Coding – Excel Tool to fetch data from OUTLOOK Folder) :-

Dim wb As Workbook

Dim ws_Main As Worksheet

Dim LrowAs Long

 

Sub Main()

 

Set wb = ThisWorkbook

Set ws_Main = wb.Sheets("Main")

 

wb.Activate

ws_Main.Activate

 

Dim myOlApp As Outlook.Application

 

Set myOlApp = CreateObject("Outlook.Application")

Set myNameSpace = myOlApp.GetNamespace("MAPI")

Set myfolders = myNameSpace.Folders

 

n = 1

Do Until myfolders.Item(n) = Trim(Range("E4").Value)

n = n + 1

Loop

 

Set myfolder = myfolders.Item(n)

Set myfolder2 = myfolder.Folders(Trim(Range("E8").Value))

'Set myfolder3 = myfolder2.Folders("MEETI")

 

c = 1

n = 1

 

ws_Main.Activate

 

 

For Each Item In myfolder2.Items

 

itsj = Item.Subject

 

itsn = Item.SenderName

 

itbo = Item.CreationTime

 

Cells(n + 1, c) = itsn

Cells(n + 1, c + 1) = itbo

Cells(n + 1, c + 2) = itsj

 

n = n + 1

 

Next Item

 

Range("A1").Select

Lrow = GetBottomRow

 

' All Border Formatting Area ***********************************************************************************

 

Range("A1").Select

Range(Selection, Selection.End(xlDown)).Select

Range(Selection, Selection.End(xlToRight)).Select

 

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.ColorIndex = 0

.TintAndShade = 0

.Weight = xlThin

End With

 

 

' All Border Formatting Area ***********************************************************************************

 

 

 

' Sorting Area *****************************************************************************************

 

Columns("B:B").Select

ActiveWorkbook.Worksheets("Main").Sort.SortFields.Clear

ActiveWorkbook.Worksheets("Main").Sort.SortFields.Add Key:=Range("B1"), _

SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal

With ActiveWorkbook.Worksheets("Main").Sort

.SetRangeRange("A2:C" &Lrow)

.Header = xlNo

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

 

' Sorting Area *****************************************************************************************

 

MsgBox "Done !!! "

 

 

 

End Sub

 

 

 

Function GetBottomRow() As Long

 

'Return the row number at the bottom of the active sheet, active column

 

ActiveSheet.Select

Cells(1048576, ActiveCell.Column).Select

Selection.End(xlUp).Select

GetBottomRow = ActiveCell.Row

 

End Function

 

Public Sub Clear()

 

Application.DisplayAlerts = False

 

Application.ScreenUpdating = False

 

Set wb = ThisWorkbook

Set ws_Main = wb.Sheets("Main")

 

ws_Main.Activate

 

 

 

Range("A1").Select

Lrow = GetBottomRow

 

If Lrow> 1 Then

 

Range("A2:C" &Lrow).Select

Selection.ClearContents

 

Application.ScreenUpdating = False

 

Range("A1").Select

 

Range("A1:C" &Lrow).Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

Selection.Borders(xlEdgeLeft).LineStyle = xlNone

Selection.Borders(xlEdgeTop).LineStyle = xlNone

Selection.Borders(xlEdgeBottom).LineStyle = xlNone

Selection.Borders(xlEdgeRight).LineStyle = xlNone

Selection.Borders(xlInsideVertical).LineStyle = xlNone

Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

 

Range("A1").Select

 

Else

 

Application.ScreenUpdating = False

 

Range("A1:C" & 1).Select

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

Selection.Borders(xlEdgeLeft).LineStyle = xlNone

Selection.Borders(xlEdgeTop).LineStyle = xlNone

Selection.Borders(xlEdgeBottom).LineStyle = xlNone

Selection.Borders(xlEdgeRight).LineStyle = xlNone

Selection.Borders(xlInsideVertical).LineStyle = xlNone

Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

 

Range("A1").Select

 

End If

 

End Sub