简体   繁体   中英

Outlook to excel using macros

My query is , i have below vba code trying to extract the outlook contents of a Particular Date - but my issue is whenever i try to run this code all the emails irrespective of the my required dates are being extracted:-

Sub GetFromInbox()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Object
Dim i As Integer
Dim Dstr As Date
Dim itms As Outlook.Items
Dim filteredItms As Outlook.Items

On Error GoTo err

dStart = Application.InputBox("Enter you start date in MM/DD/YYYY")

If dStart = Empty Then
MsgBox "Start date cannot be empty, please run it again"
Exit Sub
End If


Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.Application.ActiveExplorer.CurrentFolder
MsgBox Fldr
    i = 2

Do
For Each olMail In Fldr.Items

  If olMail.Subject = "Test - 153EN" Then
        Sheet3.Range(Cells(2, 8), Cells(2, 100)).ClearContents
        Sheet3.Cells(i, 1).Value = olMail.Subject
        Sheet3.Cells(i, 2).Value = olMail.ReceivedTime
        Sheet3.Cells(i, 3).Value = olMail.Sender

        i = i + 1
    End If

Next olMail
Loop Until (DateValue(olMail.ReceivedTime) = dStart)
err:
'Display the error message in Status bar
If err.Number > 0 Then
Application.StatusBar = err.Description
MsgBox "Err#" & err.Number & "  " & err.Description
End If
Set Fldr = Nothing
Set olNs = Nothing
Set olApp = Nothing

End Sub

I have noticed the following code:

 Do
  For Each olMail In Fldr.Items

  If olMail.Subject = "Test - 153EN" Then
    Sheet3.Range(Cells(2, 8), Cells(2, 100)).ClearContents
    Sheet3.Cells(i, 1).Value = olMail.Subject
    Sheet3.Cells(i, 2).Value = olMail.ReceivedTime
    Sheet3.Cells(i, 3).Value = olMail.Sender

    i = i + 1
  End If

 Next olMail
Loop Until (DateValue(olMail.ReceivedTime) = dStart)

The fact is that the Do loop is ignored and you iterate over all items in the folder using the following loop inside:

For Each olMail In Fldr.Items

You need to use the Find / FindNext or Restrict methods of the Items class instead. The following articles describe them in depth:

Remove the Do Loop and inside the For Loop and another outer If/then statement conditioned to your date specification:

For Each olMail In Fldr.Items
      If (DateValue(olMail.ReceivedTime) = dStart) Then
             If olMail.Subject = "Test - 153EN" Then 
                  Sheet3.Range(Cells(2, 8), Cells(2, 100)).ClearContents 
                  Sheet3.Cells(i, 1).Value = olMail.Subject 
                  Sheet3.Cells(i, 2).Value = olMail.ReceivedTime 
                  Sheet3.Cells(i, 3).Value = olMail.Sender

                  i = i + 1 
             End If
      End If
Next olMail

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM