Sub GetSentFolderDetails()
Dim a
'Early Binding: Tools > References > Microsoft Outlook xx.0 Object Library > OK
Dim oApp As Outlook.Application, oM As Outlook.MailItem
'Dim oNS As Namespace, oG As Outlook.MAPIFolder 'Usual method.
Dim oG As Outlook.Folder 'Method for IMAP, as used by Gmail.
Dim sMsg$, sAdd$, i As Long, j As Long
'Late Binding:
'Dim oApp As Object, oMI As Object, oNS As Object, oG As Object
Set oApp = CreateObject("Outlook.Application")
'Set oNS = oApp.GetNamespace("MAPI")
'Set oG = oNS.GetDefaultFolder(5) 'olFolderSentMail=5
Set oG = GetFolderPath("\\ken@gmail.com\[Gmail]\Sent Mail", oApp)
Set oM = oApp.CreateItem(0) 'olMailItem=0
ReDim a(1 To oG.Items.Count, 1 To 4)
For i = 1 To oG.Items.Count
Set oM = oG.Items(i)
If TypeName(oM) <> "MailItem" Then GoTo NextI
With oM
a(i, 1) = .To
a(i, 2) = .Subject
a(i, 3) = .SentOn
a(i, 4) = .Size
End With
NextI:
Next i
Cells(Rows.Count, "A").End(xlUp).Offset(1).Resize(UBound(a), UBound(a, 2)).Value = a
ActiveSheet.UsedRange.EntireColumn.AutoFit
[A1].Select
End Sub
'Similar to, http://www.slipstick.com/developer/working-vba-nondefault-outlook-folders/#GetFolderPath
''Early Binding: Tools > References > Microsoft Outlook xx.0 Object Library > OK
Function GetFolderPath(ByVal FolderPath As String, oApp As Outlook.Application) As Outlook.Folder
Dim oFolder As Outlook.Folder
Dim FoldersArray As Variant
Dim i As Integer
On Error GoTo GetFolderPath_Error
If Left(FolderPath, 2) = "\\" Then
FolderPath = Right(FolderPath, Len(FolderPath) - 2)
End If
'Convert folderpath to array
FoldersArray = Split(FolderPath, "\")
'Set oFolder = Application.Session.Folders.Item(FoldersArray(0))
Set oFolder = oApp.Session.Folders.Item(FoldersArray(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(FoldersArray, 1)
Dim SubFolders As Outlook.Folders
Set SubFolders = oFolder.Folders
Set oFolder = SubFolders.Item(FoldersArray(i))
If oFolder Is Nothing Then
Set GetFolderPath = Nothing
End If
Next
End If
'Return the oFolder
Set GetFolderPath = oFolder
Exit Function
GetFolderPath_Error:
Set GetFolderPath = Nothing
Exit Function
End Function