Sub GetOutlookItems()
On Error Goto GetOutlookItems_Error
'Outlook stuff
Dim objOutlook As Object
Dim objFolder As Object
Dim objTarget As Object
Dim objItem As Object
'Excel stuff
Dim wksOutput As Worksheet
Dim rngToSort As Range
Dim lngRow As Long
Set wksOutput = ActiveSheet
'Header row
lngRow = 1
wksOutput.Cells(lngRow, 1) = "SenderName"
wksOutput.Cells(lngRow, 2) = "Subject"
wksOutput.Cells(lngRow, 3) = "ConversationTopic"
wksOutput.Cells(lngRow, 4) = "ConversationIndex"
wksOutput.Cells(lngRow, 5) = "To"
wksOutput.Cells(lngRow, 6) = "SentOn"
lngRow = 2
'get the outlook stuff
Set objOutlook = GetObject(, "Outlook.Application")
'This would be a public folder
Set objFolder = objOutlook.Session.Folders("Finance")
'This is a sub-folder in the public folder
Set objTarget = objFolder.Folders("Agency HR")
For Each objItem In objTarget.Items
If objItem.Class = 43 Then 'olMail
With objItem
wksOutput.Cells(lngRow, 1) = .SenderName
wksOutput.Cells(lngRow, 2) = .Subject
wksOutput.Cells(lngRow, 3) = .ConversationTopic
wksOutput.Cells(lngRow, 4) = GUIDToString(.ConversationIndex)
wksOutput.Cells(lngRow, 5) = .To
wksOutput.Cells(lngRow, 6) = .SentOn
End With
lngRow = lngRow + 1
End If
Next objItem
'Sort the stuff in Excel
wksOutput.Range("A1:F" & lngRow).Sort Range("B2"), xlAscending, Range("C2"), , xlAscending, , , xlYes
Clean_Up:
Set wksOutput = Nothing
Set objItem = Nothing
Set objTarget = Nothing
Set objFolder = Nothing
Set objOutlook = Nothing
Exit Sub
GetOutlookItems_Error:
Debug.Print Err.Number, Err.Description
Resume Clean_Up
End Sub
Function GUIDToString(GUID As Variant) As String
Dim arrByte() As Byte
Dim intOrdinal As Integer
arrByte = GUID
For intOrdinal = 0 To UBound(arrByte)
GUIDToString = GUIDToString & Hex$(arrByte(intOrdinal))
Next intOrdinal
End Function