• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Mail sent Data to paste in Excel need help in VBA

Hi All,

Please help on this requirment,
I Need to Paste my Sent details from outlook mail to excel

Coloums in sent are
To
Subject
Sent
Size

if i copy and paste iam not getting the sent date hence if there is any macro.


Thanks Regards
Jawahar Prem
 
I use Gmail. Since it uses IMAP, it is a bit more involved. Be sure to add the Outlook object in Tools > References as I commented.

You should be able to see how I commented the usual MAPI method. You can delete the Function and the setup for the oG object and uncomment the MAPI setup for oG and oNS objects.

If you use Gmail, be sure to change the email address to yours. Otherwise, that path should be the one used for Sent items.

Code:
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
 
I doubt that would have worked even if vodfone had IMAP like Gmail.

Maybe try:
Code:
Sub GetSentFolderDetails2()
  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)
 
  On Error GoTo NextI
  j = 0
  For i = 1 To oG.Items.Count
    If TypeName(oG.Items(i)) <> "MailItem" Then GoTo NextI
    j = j + 1
    With oG.Items(i)
      a(j, 1) = .To
      a(j, 2) = .Subject
      a(j, 3) = .SentOn
      a(j, 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
 
Last edited:
Back
Top