title: How do I copy my outlook emails (within a specific time period) to excel?
body: <p>New to VBA, attempting to list my outlook emails in excel given a specific time period. Found code to list my emails, but can't figure out how to restrict it to a time period, any ideas?</p>
  
  <pre><code>Sub GetMail()
  
  Dim OLApp As Object
  Dim olFolder As Object
  Dim olMailItem As Object
  
  Dim strTo As String
  Dim strFrom As String
  Dim dateSent As Variant
  Dim dateReceived As Variant
  Dim strSubject As String
  Dim strBody As String
  
  Dim loopControl As Variant
  Dim mailCount As Long
  Dim totalItems As Long
   '-------------------------------------------------------------
  Application.ScreenUpdating = False
  Range("A1:F1").Value = Array("To", "From", "Subject", "Body", "Sent (from Sender)", "Received (by Recipient)")
  
  Columns("E:F").EntireColumn.NumberFormat = "DD/MM/YYYY HH:MM:SS"
  Set OLApp = CreateObject("Outlook.Application")
  Set olFolder = OLApp.GetNamespace("MAPI").PickFolder
  totalItems = olFolder.items.Count
  mailCount = 0
  
  For Each loopControl In olFolder.items
       '//If loopControl is a mail item then continue
      If TypeName(loopControl) = "MailItem" Then
  
          mailCount = mailCount + 1
  
          Application.StatusBar = "Reading email no. " &amp; mailCount &amp; " of " &amp; totalItems
  
          Set olMailItem = loopControl
  
          With olMailItem
              strTo = .To
  
              If Left(strTo, 1) = "=" Then strTo = "'" &amp; strTo
              strFrom = .Sender
              If InStr(1, strFrom, "@") &lt; 1 Then strFrom = strFrom &amp; " - &lt; " &amp; .SenderEmailAddress &amp; " &gt;"
              dateSent = .Body
              dateReceived = .ReceivedTime
              strSubject = .Subject
          End With
  
          With Range("A" &amp; Rows.Count).End(xlUp).Offset(1, 0)
              .Value = strTo
              .Offset(0, 1).Value = strFrom
              .Offset(0, 2).Value = strSubject
  
              If InStr(0, strBody, "From:") &gt; 0 Then
                   '//If exists, copy start of email body, up to the position of "From:"
                  .Offset(0, 3).Value = Mid(strBody, 1, InStr(1, strBody, "From:") - 1)
              Else
                  .Offset(0, 3).Value = strBody
              End If
  
              .Offset(0, 4).Value = dateSent
              .Offset(0, 5).Value = dateReceived
  
          End With
  
          Set olMailItem = Nothing
  
      End If
  Next loopControl
  
  Set olFolder = Nothing
  Set OLApp = Nothing
  Application.ScreenUpdating = True
  Application.StatusBar = False
  MsgBox mailCount &amp; " messages copied successfully.", vbInformation, "Complete"
  
  End Sub
  </code></pre>
  
  <p>New to VBA, attempting to list my outlook emails in excel given a specific time period. Found code to list my emails, but can't figure out how to restrict it to a time period, any ideas?</p>