• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 325
  • Last Modified:

How to correctly use dates search in an Excel VBA exporting data from Outlook 2007

We have an excel that searches the entire Inbox and its sub-folder for specific phrases.

We would like to incorporate to the VBA script  an efficient way to search for RECEIVINGS and SENT dates.  

For example to only display emails SENT and RECEIVED between: 10/11/11 thru 10/16/11.

Whats the best of going about it.

Please see Excel attached
0
rayluvs
Asked:
rayluvs
  • 7
  • 4
3 Solutions
 
rayluvsAuthor Commented:
0
 
Chris BottomleyCommented:
You say you have code so presumably you are happy to edit it ... but if not post it up and we can modify it:

Two subs one for each.  The efficiency comes from the filter which in the scenario I have left at 100 days ago at 10am to 'today' at 11am.

It should be changed to remove the add ... I left it there so you can see how to move the dates about.

Chris
Sub receivedMailWindow()
Dim fldr As Variant
Dim strFilter As String
Dim olkmailitems As Object
Dim olkMessage As Object
 
    Set fldr = olkApp.Session.GetDefaultFolder(6) 'olFolderInbox 
    strFilter = "[ReceivedTime] >= '" & Format(DateAdd("d", -100, Date) + TimeSerial(10, 0, 0), "ddddd h:nn AMPM") & "'" & " and " & "[ReceivedTime] < '" & Format(Date + TimeSerial(11, 0, 0), "ddddd h:nn AMPM") & "'"
    Set olkmailitems = fldr.Items.Restrict(strFilter)
    For Each olkMessage In olkmailitems
        Debug.Print olkMessage.Subject
    Next
    MsgBox "Done"
End Sub

Sub sentMailWindow()
Dim fldr As Variant
Dim strFilter As String
Dim olkmailitems As Object
Dim olkMessage As Object
 
    Set fldr = olkAPP.Session.GetDefaultFolder(5) 'olFolderSentMail
    strFilter = "[SentON] >= '" & Format(DateAdd("d", -100, Date) + TimeSerial(10, 0, 0), "ddddd h:nn AMPM") & "'" & " and " & "[ReceivedTime] < '" & Format(Date + TimeSerial(11, 0, 0), "ddddd h:nn AMPM") & "'"
    Set olkmailitems = fldr.Items.Restrict(strFilter)
    For Each olkMessage In olkmailitems
        Debug.Print olkMessage.Subject
    Next
    MsgBox "Done"
End Sub

Open in new window

0
 
rayluvsAuthor Commented:
i included the link, see ID 36978545.  we just want to display based on dates range
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
Chris BottomleyCommented:
Sorry, I was thinking that was another experts post!

I have only changed sub ExtractFromEmails_ProcessAllSubFolders everything else I have left alone.

Chris


Sub ExtractFromEmails_ProcessAllSubFolders()

    Dim i As Long
    Dim j As Long
    Dim n As Long
    Dim StrSubject As String
    Dim StrReceived As String
    Dim strName As String
    Dim strTo As String
    Dim strToEmailAddr As String
    Dim strFrom As String
    Dim strFromEmailAddr As String
    Dim strType As String
    Dim strFollowup As String
    Dim strCategory As String
    Dim strCommentObserv As String
    Dim StrFile As String
    Dim StrSavePath As String
    Dim StrFolder As String
    Dim StrFolderPath As String
    Dim StrSaveFolder As String
    Dim Prompt As String
    Dim Title As String
    Dim iNameSpace As NameSpace
    Dim myOlApp As Outlook.Application
    Dim SubFolder As MAPIFolder
    Dim mItem As MailItem
    Dim FSO As Object
    Dim ChosenFolder As Object
    Dim Folders As New Collection
    Dim EntryID As New Collection
    Dim StoreID As New Collection
    Dim strFilter As String
    Dim olkmailitems As Object
 

    Dim outWks As Worksheet

    Dim outCursor As Range
    Dim myRecipient As Variant
    Dim StrSearch As String

    Set outWks = ThisWorkbook.Sheets("Extract Output")

    outWks.Cells.ClearContents

    Set outCursor = outWks.Range("A1")

    outCursor.Value = "From"
    outCursor.Offset(0, 1).Value = "From Email Address"
    outCursor.Offset(0, 2).Value = "Subject"
    outCursor.Offset(0, 3).Value = "Received"
    outCursor.Offset(0, 4).Value = "To"
    outCursor.Offset(0, 5).Value = "To Email Address"
    outCursor.Offset(0, 6).Value = "Type"
    outCursor.Offset(0, 7).Value = "Followup"
    outCursor.Offset(0, 8).Value = "Category"
    outCursor.Offset(0, 9).Value = "CommentObserv"
    outCursor.Offset(0, 10).Value = "Folder"

    Range(outCursor, outCursor.Offset(0, 10)).Font.Bold = True

    Set outCursor = outCursor.Offset(1, 0)

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set myOlApp = Outlook.Application
    Set iNameSpace = myOlApp.GetNamespace("MAPI")
    Set ChosenFolder = iNameSpace.PickFolder

    If ChosenFolder Is Nothing Then GoTo ExitSub

    Call GetFolder(Folders, EntryID, StoreID, ChosenFolder)
    
    AppActivate "Microsoft Excel"
    ''''''''' SEARCH string ''''''''''''''''''
    StrSearch = InputBox("Enter search string")
    ''''''''''''''''''''''''''''''''''''''''''

    For i = 1 To Folders.Count

        Set SubFolder = myOlApp.Session.GetFolderFromID(EntryID(i), StoreID(i))
        On Error Resume Next
        strFilter = "[ReceivedTime] >= '" & Format(DateAdd("d", -1, Date) + TimeSerial(0, 0, 0), "ddddd h:nn AMPM") & "'" & " and " & "[ReceivedTime] < '" & Format(Date + TimeSerial(0, 0, 0), "ddddd h:nn AMPM") & "'"
        Set olkmailitems = SubFolder.Items.Restrict(strFilter)
        For Each mItem In olkmailitems
            StrSubject = mItem.Subject
            StrReceived = ArrangedDate(mItem.ReceivedTime)
            strTo = mItem.To
            'strtoemailaddr = mitem.
            strFrom = mItem.SenderName
            strFromEmailAddr = mItem.SenderEmailAddress
            strType = mItem.UserProperties("Type")    ' user defined
            strFollowup = mItem.UserProperties("FollowUp")    'user defined
            strCategory = mItem.Categories
            strCommentObserv = mItem.UserProperties("CommentObserv")    'user defined
            strName = StripIllegalChar(StrSubject)

            For Each myRecipient In mItem.Recipients
                strToEmailAddr = myRecipient.Address & "," & strToEmailAddr
            Next myRecipient

            If Len(strToEmailAddr) > 1 Then
                strToEmailAddr = Left(strToEmailAddr, Len(strToEmailAddr) - 1)
            End If
            ''''''''''''' Check subject search string here ''''''''''''
            If InStr(StrSubject, StrSearch) > 0 Or InStr(mItem.Body, StrSearch) > 0 Then
            
                '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
                'now write it out
                outCursor.Value = strFrom
                outCursor.Offset(0, 1).Value = strFromEmailAddr
                outCursor.Offset(0, 2).Value = StrSubject
                outCursor.Offset(0, 3).Value = StrReceived
                outCursor.Offset(0, 4).Value = strTo
                outCursor.Offset(0, 5).Value = strToEmailAddr
                outCursor.Offset(0, 6).Value = strType
                outCursor.Offset(0, 7).Value = strFollowup
                outCursor.Offset(0, 8).Value = strCategory
                outCursor.Offset(0, 9).Value = strCommentObserv
                outCursor.Offset(0, 10).Value = mItem.Parent.FullFolderPath

                Set outCursor = outCursor.Offset(1, 0)
            End If

        Next
        On Error GoTo 0
    Next i

ExitSub:

End Sub

Open in new window

0
 
Chris BottomleyCommented:
Note the current span is all day 'yesterday' start time at midnight to the end time at midnight 'last' night hence 24 hrs.

Amending data as required will of course adapt the return according to the criteria.

Chris
0
 
rayluvsAuthor Commented:
Will try when get back home.  But reading your post I don't quite understand.  

Anyways, just to make sure what we are trying to: we would like to modify the VBA to export, using a filter format of FROM/TO for a specific week (10/10/11 - 10/16/11), a specific day (10/10/11 - 10/16/11)  or specific year (01/01/11 - 12/31/11)


0
 
rayluvsAuthor Commented:
Ooops! for specific day, we meant (10/16/11 - 10/16/11)
0
 
rayluvsAuthor Commented:
just checked it.

We assume that we have to enter dates where ""ddddd h:nn AMPM"" is located?

Whats the format for:
specific week (10/10/11 - 10/16/11)
a specific day (10/16/11 - 10/16/11)
specific year (01/01/11 - 12/31/11)

is it ""101011 h:nn AMPM""?

0
 
rayluvsAuthor Commented:
maybe only filtering only receipt dates instead of both?
0
 
Chris BottomleyCommented:
For example:

10/10/11 - 10/16/11

"[ReceivedTime] >= '" & Format(datevalue("10 Oct 2011") + TimeSerial(0, 0, 0), "ddddd h:nn AMPM") & "'" & " and " & "[ReceivedTime] < '" & Format(datevalue("16 Oct 2011") + TimeSerial(0, 0, 0), "ddddd h:nn AMPM") & "'"

Chris
0
 
rayluvsAuthor Commented:
Thanx
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

  • 7
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now