Is there any possibilities to copy mails from more than one folder in same time.

[Mariappan]

Sub D()
    Dim str As String
    Dim ws As Worksheet
    str = Format(Date, "dd-mm-yyyy")
    Sheets.Add , Worksheets(Worksheets.Count)
    ActiveSheet.Name = Format(Date, "dd-mm-yyyy")
    Worksheets("ONE").[a1].CurrentRegion.Copy [a1]
    ThisWorkbook.RefreshAll
    Call T
End Sub

Sub O()
    Dim olapp As Outlook.Application
    Dim olNs As Namespace
    Dim strDateEntry As String
    Dim Fldr As MAPIFolder
    Dim olMail As Variant
    'Dim date1 As Date
    Dim i As Integer
    'Sheets("sheet1").Visible = True
    'Sheets("sheet1").Select
    Cells.Select
    Selection.SpecialCells(xlCellTypeConstants, 23).Select
    Selection.ClearContents
    'Cells(1, 1).Value = "Date"
    Set olapp = New Outlook.Application
    Set olNs = olapp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("2014")
  
       ' strDateEntry = InputBox("Enter the date as mm/dd/yyyy", "Date Entry", "enter date as mm/dd/yyyy")
     i = 1
            For Each olMail In Fldr.Items
                       If olMail.ReceivedTime > strDateEntry And olMail.SenderName <> "xxx" Then
                                ActiveSheet.Cells(i, 1).Value = olMail.ReceivedTime
                            ActiveSheet.Cells(i, 2).Value = olMail.Subject
                            ActiveSheet.Cells(i, 3).Value = olMail.SenderName
                       End If
                i = i + 1
             Next olMail
   Range("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
End Sub

 

[Luke M]

Hi Mariappan,

Would you mind giving a bit more background/explanation as to what you want to accomplish? The code you posted has several lines commented out, and no explanatory comments, so I'm not sure what the overall goal is.