# Vba to move emails from Inbox to personal folder



## Pranesh (May 2, 2019)

Hi,

I receive 20 to 25 emails a day from a common mail box daily to my Outlook 2016. I will then move those emails to a personal folder named "Daily email1" & "Daily email 2" based on email subject. 

I want this to be automated. Whenever I get those emails I want a button to run a code which should move those emails to respective folder based on email subject. Once that is done I need Macro to prepare a report to say how many emails has been received from that email box and need a list of email subject with the mail received time in body of the email which should be sent to a user.

I searched online for VBA codes but no luck. Can someone help me.


----------



## Domenic (May 2, 2019)

The following macro should be placed in a regular module (Visual Basic Editor >> Insert >> Module).  You'll need to change the code where specified.  Also, as it stands, the code will only display the email, it won't send it.  Once you've tested it and everything is fine, you can replace .display with .send, and then uncomment those few lines where indicated within the code.


```
Option Explicit

Sub MoveAndEmailReport()


    Dim olApp As Object
    Dim olNS As Object
    Dim olInBox As Object
    Dim olFolderDaily1 As Object
    Dim olFolderDaily2 As Object
    Dim olItem As Object
    Dim olMail As Object
    Dim strSearchForSubject1 As String
    Dim strSearchForSubject2 As String
    Dim strHtmlContents As String
    Dim strHtmlBody As String
    Dim blnStarted As Boolean
    Dim blnMoved As Boolean
    Dim emailCount As Long
    Dim itemIndex As Long
    
    On Error Resume Next
    'Get Outlook, if its already running
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        'Outlook wasn't already running, so start it
        Set olApp = CreateObject("Outlook.Application")
        If olApp Is Nothing Then
            MsgBox "Unable to open Outlook!", vbExclamation
            Exit Sub
        End If
        blnStarted = True
    End If
    On Error GoTo errHandler
    
    'Set namespace
    Set olNS = olApp.GetNamespace("MAPI")
    
    'Set inbox
    Set olInBox = olNS.GetDefaultFolder(6) 'olFolderInbox
    
    'Set first personal folder
    Set olFolderDaily1 = olNS.Folders("Daily email1")
    
    'Set second personal folder
    Set olFolderDaily2 = olNS.Folders("Daily email2")
    
    strSearchForSubject1 = "MySubject1" 'change first subject to search for
    strSearchForSubject2 = "MySubject2" 'change second subject to search for
    
    'Loop through each item in inbox, move items that meet the criteria to their
    'respective folder, collect relevant data in html table format, and keep track of
    'number of emails that met criteria and were moved
    strHtmlContents = ""
    emailCount = 0
    For itemIndex = olInBox.items.Count To 1 Step -1
        Set olItem = olInBox.items(itemIndex)
        If TypeName(olItem) = "MailItem" Then
            If InStr(1, olItem.Subject, strSearchForSubject1, vbTextCompare) > 0 Then
                olItem.Move olFolderDaily1
                blnMoved = True
            ElseIf InStr(1, olItem.Subject, strSearchForSubject2, vbTextCompare) Then
                olItem.Move olFolderDaily2
                blnMoved = True
            End If
            If blnMoved Then
                strHtmlContents = strHtmlContents & vbCrLf & "<tr>"
                strHtmlContents = strHtmlContents & vbCrLf & "<td>" & olItem.Subject & "</td>"
                strHtmlContents = strHtmlContents & vbCrLf & "<td>" & olItem.receivedtime & "</td>"
                strHtmlContents = strHtmlContents & vbCrLf & "</tr>"
                emailCount = emailCount + 1
                blnMoved = False
            End If
        End If
    Next itemIndex
    
    'If one or more emails met the criteria and were moved, add the necessary html code
    'to complete the formatting for the html table, and then create a new email with the data
    'collected and send it to the specified user
    If emailCount > 0 Then
        strHtmlBody = "<table width=100% border=1 cellpadding=3>"
        strHtmlBody = strHtmlBody & "<tr>"
        strHtmlBody = strHtmlBody & vbCrLf & "<th width=70% align=left>Subject</th>"
        strHtmlBody = strHtmlBody & vbCrLf & "<th align=left>Received Time</th>"
        strHtmlBody = strHtmlBody & vbCrLf & "</tr>"
        strHtmlBody = strHtmlBody & vbCrLf & strHtmlContents
        strHtmlBody = strHtmlBody & vbCrLf & "</table>"
        Set olMail = olApp.CreateItem(0)
        With olMail
            .To = "johnsmith@example.com" 'change the email address accordingly
            .Subject = "List of emails received" 'change the subject accordingly
            .htmlbody = "<p>Number of emails received: " & emailCount & "</p>"
            .htmlbody = .htmlbody & strHtmlBody
            .display 'to display email instead of sending it
            '.send 'to send email instead of displaying it
        End With
        MsgBox emailCount & " email(s) received and moved, and report sent.", vbInformation
    Else
        MsgBox "No emails received.", vbInformation
    End If
    
exitHandler:
    'If Outlook was started, close it
    'Uncomment next 3 lines when emails are actual being sent
    'If blnStarted Then
        'olApp.Quit
    'End If
    
    Set olApp = Nothing
    Set olNS = Nothing
    Set olInBox = Nothing
    Set olFolderDaily1 = Nothing
    Set olFolderDaily2 = Nothing
    Set olItem = Nothing
    Set olMail = Nothing
    
    Exit Sub
    
errHandler:
    MsgBox "Error " & Err.Number & ":" & vbCrLf & vbCrLf & Err.Description, vbCritical, "Error"
    Resume exitHandler
    
End Sub
```


----------



## Pranesh (May 3, 2019)

Domenic said:


> The following macro should be placed in a regular module (Visual Basic Editor >> Insert >> Module).  You'll need to change the code where specified.  Also, as it stands, the code will only display the email, it won't send it.  Once you've tested it and everything is fine, you can replace .display with .send, and then uncomment those few lines where indicated within the code.
> 
> 
> ```
> ...



Hi Domenic,

Thank you so much for your help. I pasted the code in a Module in excel and try to run it. Im getting "An object could not be found" error. I guess it is not finding the folder. Under personal folder I have a group name called "DailyMail" and under that I have these 2 folders Daily email1 & Daily email2. 

Based on subject I will have more emails with same name and at the end there will be names added which will differentiate each email. Instead of that as said earlier  received all those emails from a common mail box. So can the code be changed as to moved all emails received from that common mail box to Daily email1?


----------



## Domenic (May 3, 2019)

Pranesh said:


> Hi Domenic,



Hi Pranesh!



> Thank you so much for your help. I pasted the code in a Module in excel and try to run it. Im getting "An object could not be found" error. I guess it is not finding the folder. Under personal folder I have a group name called "DailyMail" and under that I have these 2 folders Daily email1 & Daily email2.



In that case, try the following instead..


```
'Set first daily folder
    Set olFolderDaily1 = olNS.Folders("DailyMail").Folders("Daily email1")
    
    'Set second daily folder
    Set olFolderDaily2 = olNS.Folders("DailyMail").Folders("Daily email2")
```



> Based on subject I will have more emails with same name and at the end there will be names added which will differentiate each email. Instead of that as said earlier  received all those emails from a common mail box. So can the code be changed as to moved all emails received from that common mail box to Daily email1?



I don't understand.  Can you please explain?  Also, can you provide some examples?


----------



## Pranesh (May 6, 2019)

Domenic said:


> Hi Pranesh!
> 
> 
> 
> ...



Hi, 

Thanks for your help.

My email subject will be like Daily mailer - NA, Daily Mailer - UK, Daily Mailer - APAC likewise I will have emails, so instead of moving the mails based on email subject, I would like to move the mails based on received from email address.

So all the emails received from that email should be moved to only 1 folder named "Daily Mailers"


----------



## Domenic (May 6, 2019)

The following macro has been amended so that emails received from a specified email address will be moved, etc....


```
Option Explicit

Sub MoveAndEmailReport()


    Dim olApp As Object
    Dim olNS As Object
    Dim olInBox As Object
    Dim olMoveToFolder As Object
    Dim olItem As Object
    Dim olMail As Object
    Dim strHtmlContents As String
    Dim strHtmlBody As String
    Dim blnStarted As Boolean
    Dim emailCount As Long
    Dim itemIndex As Long
    
    On Error Resume Next
    'Get Outlook, if its already running
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        'Outlook wasn't already running, so start it
        Set olApp = CreateObject("Outlook.Application")
        If olApp Is Nothing Then
            MsgBox "Unable to open Outlook!", vbExclamation
            Exit Sub
        End If
        blnStarted = True
    End If
    On Error GoTo errHandler
    
    'Set namespace
    Set olNS = olApp.GetNamespace("MAPI")
    
    'Set inbox
    Set olInBox = olNS.GetDefaultFolder(6) 'olFolderInbox
    
    'Set folder to move emails to
    Set olMoveToFolder = olNS.Folders("DailyMail").Folders("Daily Mailers")
    
    'Loop through each item in inbox, move items that meet the criteria to their
    'respective folder, collect relevant data in html table format, and keep track of
    'number of emails that met criteria and were moved
    strHtmlContents = ""
    emailCount = 0
    For itemIndex = olInBox.items.Count To 1 Step -1
        Set olItem = olInBox.items(itemIndex)
        If TypeName(olItem) = "MailItem" Then
            If olItem.SenderEmailAddress = "janedoe@example.com" Then 'change the email address accordingly
                strHtmlContents = strHtmlContents & vbCrLf & "<tr>"
                strHtmlContents = strHtmlContents & vbCrLf & "<td>" & olItem.Subject & "</td>"
                strHtmlContents = strHtmlContents & vbCrLf & "<td>" & olItem.receivedtime & "</td>"
                strHtmlContents = strHtmlContents & vbCrLf & "</tr>"
                olItem.Move olMoveToFolder
                emailCount = emailCount + 1
            End If
        End If
    Next itemIndex
    
    'If one or more emails met the criteria and were moved, add the necessary html code
    'to complete the formatting for the html table, and then create a new email with the data
    'collected and send it to the specified user
    If emailCount > 0 Then
        strHtmlBody = "<table width=100% border=1 cellpadding=3>"
        strHtmlBody = strHtmlBody & "<tr>"
        strHtmlBody = strHtmlBody & vbCrLf & "<th width=70% align=left>Subject</th>"
        strHtmlBody = strHtmlBody & vbCrLf & "<th align=left>Received Time</th>"
        strHtmlBody = strHtmlBody & vbCrLf & "</tr>"
        strHtmlBody = strHtmlBody & vbCrLf & strHtmlContents
        strHtmlBody = strHtmlBody & vbCrLf & "</table>"
        Set olMail = olApp.CreateItem(0)
        With olMail
            .To = "johnsmith@example.com" 'change the email address accordingly
            .Subject = "List of emails received" 'change the subject accordingly
            .htmlbody = "<p>Number of emails received: " & emailCount & "</p>"
            .htmlbody = .htmlbody & strHtmlBody
            .display 'to display email instead of sending it
            '.send 'to send email instead of displaying it
        End With
        MsgBox emailCount & " email(s) received and moved, and report sent.", vbInformation
    Else
        MsgBox "No emails received.", vbInformation
    End If
    
exitHandler:
    'If Outlook was started, close it
    'Uncomment next 3 lines when emails are actual being sent
    'If blnStarted Then
        'olApp.Quit
    'End If
    
    Set olApp = Nothing
    Set olNS = Nothing
    Set olInBox = Nothing
    Set olMoveToFolder = Nothing
    Set olItem = Nothing
    Set olMail = Nothing
    
    Exit Sub
    
errHandler:
    MsgBox "Error " & Err.Number & ":" & vbCrLf & vbCrLf & Err.Description, vbCritical, "Error"
    Resume exitHandler
    
End Sub
```


----------



## Pranesh (May 7, 2019)

Domenic said:


> The following macro has been amended so that emails received from a specified email address will be moved, etc....
> 
> 
> ```
> ...



Hi Domenic,

Thanks for your time.

I Run the code this time it correctly identified the Folder which was created. I have updated the email address where you have said me to change it. But I received a Msg box stating No mails received, but im having 10 emails in my Inbox.


----------



## Domenic (May 7, 2019)

Since the comparison is case-sensitive, try replacing...


```
If olItem.SenderEmailAddress = "janedoe@example.com"
```
with


```
If UCase(olItem.SenderEmailAddress) = "JANEDOE@EXAMPLE.COM"
```
Does this help?


----------



## Pranesh (May 8, 2019)

Domenic said:


> Since the comparison is case-sensitive, try replacing...
> 
> 
> ```
> ...



Hi Domenic,

I'm still getting the same error. That common email ID will be a combination of Upper and Lower case.


----------



## Domenic (May 8, 2019)

The reason I asked you to replace that line is so that the comparison would not be case-sensitive.  So when you change the email address in the code to the actual email address, simply make sure that the email address is all capitals.  This way it won't matter how the address appears in the email itself.


----------



## Pranesh (May 2, 2019)

Hi,

I receive 20 to 25 emails a day from a common mail box daily to my Outlook 2016. I will then move those emails to a personal folder named "Daily email1" & "Daily email 2" based on email subject. 

I want this to be automated. Whenever I get those emails I want a button to run a code which should move those emails to respective folder based on email subject. Once that is done I need Macro to prepare a report to say how many emails has been received from that email box and need a list of email subject with the mail received time in body of the email which should be sent to a user.

I searched online for VBA codes but no luck. Can someone help me.


----------



## Pranesh (May 9, 2019)

Domenic said:


> The reason I asked you to replace that line is so that the comparison would not be case-sensitive.  So when you change the email address in the code to the actual email address, simply make sure that the email address is all capitals.  This way it won't matter how the address appears in the email itself.



Hi Domenic,

I have changed the code and updated the email address with capitals, but still getting no emails received error.


----------



## Domenic (May 9, 2019)

First, let's make sure that you're specifying the correct email address in your code.  Go to the folder that contains your emails.  Then, double-click one of the target emails so that it opens up and displays.  Now open the Visual Basic Editor (Alt+F11) within Outlook.  Then, display the Immediate window (Alt+G).  Then, type the following line in the Immediate window and press Enter...


```
? activeinspector.CurrentItem.senderemailaddress
```

It should match the email address specified in the code, except that the one in the code will be all capitals.  Does it match?


----------



## Pranesh (May 10, 2019)

Domenic said:


> First, let's make sure that you're specifying the correct email address in your code.  Go to the folder that contains your emails.  Then, double-click one of the target emails so that it opens up and displays.  Now open the Visual Basic Editor (Alt+F11) within Outlook.  Then, display the Immediate window (Alt+G).  Then, type the following line in the Immediate window and press Enter...
> 
> 
> ```
> ...



Hi Domenic,


I applied your code in Outlook and as a output i got the email name. For example my email ID is EMAILSUPPORT@ABC.COM after applying your code i it gave me the email name "EMAILSUPPORT"


I tried both with email name and email address in the below code but again getting "No emails received" msg box.


```
If UCase(olItem.SenderEmailAddress) = "[EMAIL="EMAILSUPPORT@ABC.COM"]EMAILSUPPORT@ABC.COM[/EMAIL]" Then
If UCase(olItem.SenderEmailAddress) = "EMAILSUPPORT" Then
```


----------



## Domenic (May 10, 2019)

> I applied your code in Outlook and as a output i got the email name. For example my email ID is EMAILSUPPORT@ABC.COM after applying your code i it gave me the email name "EMAILSUPPORT"



I don't understand why it returns the sender's name, instead of the actual sender's email address.  In any case, I have re-read your original post, and I see that you said that the emails are located within a common mail box.  So it looks like they're not located in your default inbox.  So we're probably referencing the wrong mail box.

Try this.  Go to Outlook, select the folder that contains your emails (select just the folder, not an email), and then within Outlook go to the Visual Basic Editor (Alt+F11), type the following line of code and press ENTER...


```
? ActiveExplorer.CurrentFolder.FolderPath
```

It should return something like this...


```
\\MyFolder\Inbox
```

Then simply change the line setting the inbox accordingly.  With this example, it would be...


```
Set olInBox = olNS.Folders("MyFolder").Folders("Inbox")
```

Then, hopefully, .senderEmailAddress will return the actual sender's email address, in which case you should use "EMAILSUPPORT@ABC.COM".  Otherwise, if it returns the sender's name, use "EMAILSUPORT" instead.

Does this help?


----------



## Pranesh (May 13, 2019)

Domenic said:


> I don't understand why it returns the sender's name, instead of the actual sender's email address.  In any case, I have re-read your original post, and I see that you said that the emails are located within a common mail box.  So it looks like they're not located in your default inbox.  So we're probably referencing the wrong mail box.
> 
> Try this.  Go to Outlook, select the folder that contains your emails (select just the folder, not an email), and then within Outlook go to the Visual Basic Editor (Alt+F11), type the following line of code and press ENTER...
> 
> ...



Hi Domenic,
I will receive the emails from a common Mail box, but i dont have that common mail box in my Outlook. So as of now the emails has been received in my Inbox.


I also opened an email of my friend which was in my Inbox and applied your code but instead of his email ID and getting his name.


----------



## Domenic (May 13, 2019)

Yeah, I'm not sure why you're getting his name, instead of his email address, when using .senderEmailAddress.  In that case, though, simply test for his name.


----------



## Pranesh (May 17, 2019)

Domenic said:


> Yeah, I'm not sure why you're getting his name, instead of his email address, when using .senderEmailAddress.  In that case, though, simply test for his name.



Hi Domenic,

Tested with name as well but not working. If you can try with some dummy data might help. I'm not sure how to fix it.


----------



## Domenic (May 17, 2019)

I still think the problem is that we're referencing the wrong folder.  You said that it's a common mail box, so I guess it's a shared folder.  I searched Google, and it seems that we would need to change how we access this shared folder.  I haven't been able to test it, but I think that the following code should work.  Any changes or additions are marked in red.  And make the necessary changes, where indicated.  Also, don't forget to remove the spaces after each occurrence of angled brackets (<).  Please let me know whether this helps.


```
Option Explicit

Sub MoveAndEmailReport()

    Dim olApp As Object
    Dim olNS As Object
    [COLOR=#ff0000]Dim olRecipient As Object
    Dim olSharedInbox As Object[/COLOR]
    Dim olMoveToFolder As Object
    Dim olItem As Object
    Dim olMail As Object
    Dim strHtmlContents As String
    Dim strHtmlBody As String
    Dim blnStarted As Boolean
    Dim emailCount As Long
    Dim itemIndex As Long
    
    On Error Resume Next
    'Get Outlook, if its already running
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        'Outlook wasn't already running, so start it
        Set olApp = CreateObject("Outlook.Application")
        If olApp Is Nothing Then
            MsgBox "Unable to open Outlook!", vbExclamation
            Exit Sub
        End If
        blnStarted = True
    End If
    On Error GoTo errHandler
    
    'Set namespace
    Set olNS = olApp.GetNamespace("MAPI")
    
    [COLOR=#ff0000]'Set recipient, it can be a string representing the display name,
    'the alias, or email address of the recipient (change accordingly)
    Set olRecipient = olNS.CreateRecipient("pranesh@email.com")
    
    'Resolve the Recipient object against the address book
    olRecipient.Resolve
    
    'Check whether Recipient object is resolved
    If Not olRecipient.Resolved Then
        MsgBox "Unable to resolve Recipient object!", vbExclamation
        GoTo exitHandler
    End If
    
    'Set the shared default inbox
    Set olSharedInbox = olNS.GetSharedDefaultFolder(olRecipient, 6) '6=olFolderInbox[/COLOR]
    
    'Set folder to move emails to
    Set olMoveToFolder = olNS.Folders("DailyMail").Folders("Daily Mailers")
    
    'Loop through each item in inbox, move items that meet the criteria to their
    'respective folder, collect relevant data in html table format, and keep track of
    'number of emails that met criteria and were moved
    strHtmlContents = ""
    emailCount = 0
    For itemIndex = olSharedInbox.Items.Count To 1 Step -1
        Set olItem = olSharedInbox.Items(itemIndex)
        If TypeName(olItem) = "MailItem" Then
            If olItem.SenderEmailAddress = "janedoe@example.com" Then 'change the email address accordingly
                strHtmlContents = strHtmlContents & vbCrLf & "< tr>"
                strHtmlContents = strHtmlContents & vbCrLf & "< td>" & olItem.Subject & "< /td>"
                strHtmlContents = strHtmlContents & vbCrLf & "< td>" & olItem.receivedtime & "< /td>"
                strHtmlContents = strHtmlContents & vbCrLf & "< /tr>"
                olItem.Move olMoveToFolder
                emailCount = emailCount + 1
            End If
        End If
    Next itemIndex
    
    'If one or more emails met the criteria and were moved, add the necessary html code
    'to complete the formatting for the html table, and then create a new email with the data
    'collected and send it to the specified user
    If emailCount > 0 Then
        strHtmlBody = "< table width=100% border=1 cellpadding=3>"
        strHtmlBody = strHtmlBody & "< tr>"
        strHtmlBody = strHtmlBody & vbCrLf & "< th width=70% align=left>Subject< /th>"
        strHtmlBody = strHtmlBody & vbCrLf & "< th align=left>Received Time< /th>"
        strHtmlBody = strHtmlBody & vbCrLf & "< /tr>"
        strHtmlBody = strHtmlBody & vbCrLf & strHtmlContents
        strHtmlBody = strHtmlBody & vbCrLf & "< /table>"
        Set olMail = olApp.CreateItem(0)
        With olMail
            .To = "johnsmith@example.com" 'change the email address accordingly
            .Subject = "List of emails received" 'change the subject accordingly
            .htmlbody = "< p>Number of emails received: " & emailCount & "< /p>"
            .htmlbody = .htmlbody & strHtmlBody
            .display 'to display email instead of sending it
            '.send 'to send email instead of displaying it
        End With
        MsgBox emailCount & " email(s) received and moved, and report sent.", vbInformation
    Else
        MsgBox "No emails received.", vbInformation
    End If
    
exitHandler:
    'If Outlook was started, close it
    'Uncomment next 3 lines when emails are actual being sent
    'If blnStarted Then
        'olApp.Quit
    'End If
    
    Set olApp = Nothing
    Set olNS = Nothing
    Set olSharedInbox = Nothing
    Set olMoveToFolder = Nothing
    Set olItem = Nothing
    Set olMail = Nothing
    
    Exit Sub
    
errHandler:
    MsgBox "Error " & Err.Number & ":" & vbCrLf & vbCrLf & Err.Description, vbCritical, "Error"
    Resume exitHandler
    
End Sub
```


----------



## Pranesh (May 24, 2019)

Domenic said:


> I still think the problem is that we're referencing the wrong folder.  You said that it's a common mail box, so I guess it's a shared folder.  I searched Google, and it seems that we would need to change how we access this shared folder.  I haven't been able to test it, but I think that the following code should work.  Any changes or additions are marked in red.  And make the necessary changes, where indicated.  Also, don't forget to remove the spaces after each occurrence of angled brackets (<).  Please let me know whether this helps.
> 
> 
> ```
> ...



Hi Domenic,


It is not a shared folder. I will explain it clearly now. I receive emails from a Distribution List(DL). In that DL there will be few users mail IDs who are part of that DL, and there will be a common Mail ID for that particular DL. If we send emails to that DL it will reach to all the recipients who are part of that list.


So these emails are received to me from that DL to my Inbox. Then i need to find out those emails and move them to a specific folder and send a mail stating the list of emails received which is basically the subject of the email and the time it was received.

Do i need to change anything in the below code. What does "MailItem" means. When code is executed it is showing as nothing in it.


```
If TypeName(olItem) = "MailItem" Then
```


----------



## Domenic (May 24, 2019)

> So these emails are received to me from that DL to my Inbox.



In that case, the code in Post #6 in this thread should work.  Can you confirm whether the "Inbox" is your default inbox?  Or whether it's an inbox within a personal folder?  It might help if you posted an image of the folder structure in Outlook.




> Do i need to change anything in the below code. What does "MailItem" means.
> 
> 
> ```
> ...



That line checks whether the item is a mail item, meeting item, etc.  It resolves to True if the item is a mail item.  If you stop your code at that line and move your cursor over olItem, it should display the subject.


----------



## Pranesh (May 2, 2019)

Hi,

I receive 20 to 25 emails a day from a common mail box daily to my Outlook 2016. I will then move those emails to a personal folder named "Daily email1" & "Daily email 2" based on email subject. 

I want this to be automated. Whenever I get those emails I want a button to run a code which should move those emails to respective folder based on email subject. Once that is done I need Macro to prepare a report to say how many emails has been received from that email box and need a list of email subject with the mail received time in body of the email which should be sent to a user.

I searched online for VBA codes but no luck. Can someone help me.


----------



## Pranesh (May 27, 2019)

Domenic said:


> In that case, the code in Post #6 in this thread should work.  Can you confirm whether the "Inbox" is your default inbox?  Or whether it's an inbox within a personal folder?  It might help if you posted an image of the folder structure in Outlook.
> 
> 
> 
> ...




Hi Domenic,


As you said i took post#6 and run it but it was not working and found that the receipient address is the only issue. Senderemailaddress is not only taking the email id or name, but before that there are someother things included. So i copied that entirely and run the macro and it worked perfectly.


Thank you so much for your patience and help till now. I need few more help from you. 


1, Instead of searching the entire inbox i need to pick only the specific date to search for emails. For example if i give 05/27/2019 in cell A1 it should look for emails received only on that date and move those mails and created table.

2, Usually i receive those mailers between 9-10AM and i might run this Macro by 11AM. By that time sometimes there would be some queries raised on any of the emails and there would be reply from the DL with subject starting as RE: or FW: so the macro moves the RE: & FW: emails as well and that should not happen. Basically it should move only mails with subject not starting as RE: or FW:

3, Need to include "S.No" as 1st column in table followed by email subject and received time.

4, In addition to it i need one more column to be included. There are few emails which will be received on 8:30AM daily at times due to some technical issue the email would have received by 9:30 or 10:00AM. I have the list of emails(Column A) and the time they usually receive(Column B) in the excel sheet where i run this macro. I need the macro to compare the received time which is updated in table(Macro output) with the usuall receive time i have in the excell and should give status as "On Time" if it has received 30min prior the original receive time or 30min after the original receive time, else it should update as "__Min Delay"(For example - if the mail received time is updated in excel as 8:30AM and if the mail is received between 8:00AM to 9:00AM it should be "On Time". If the email is received after 9:01AM then the status should be updated as "__Min Delay" based on the delay time.


 Sorry to disturb you a lot. Thanks for helping me. Hope you would help me with this additional request as well.


----------



## Domenic (May 27, 2019)

I've only had a chance to address #1  and #2 , so I suggested you start a new thread for help with #3  and #4 .  Here's the code, which has been amended to address #1  and #2 ...


```
Sub MoveAndEmailReport()

    Dim olApp As Object
    Dim olNS As Object
    Dim olInBox As Object
    Dim olRestrictedItems As Object
    Dim strFilter1 As String
    Dim strFilter2 As String
    Dim olMoveToFolder As Object
    Dim olItem As Object
    Dim olMail As Object
    Dim strHtmlContents As String
    Dim strHtmlBody As String
    Dim blnStarted As Boolean
    Dim emailCount As Long
    Dim itemIndex As Long
    
    On Error Resume Next
    'Get Outlook, if its already running
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        'Outlook wasn't already running, so start it
        Set olApp = CreateObject("Outlook.Application")
        If olApp Is Nothing Then
            MsgBox "Unable to open Outlook!", vbExclamation
            Exit Sub
        End If
        blnStarted = True
    End If
    On Error GoTo errHandler
    
    'Set namespace
    Set olNS = olApp.GetNamespace("MAPI")
    
    'Set inbox
    Set olInBox = olNS.GetDefaultFolder(6) 'olFolderInbox
    
    'Filter items for date specified in cell A1 in Sheet1 (change the sheet reference accordingly)
    strFilter1 = "[ReceivedTime] >= '" & Format(Worksheets("Sheet1").Range("A1").Value, "ddddd h:nn AMPM") & "'"
    strFilter2 = "[ReceivedTime] < '" & Format(Worksheets("Sheet1").Range("A1").Value + 1, "ddddd h:nn AMPM") & "'"
    Set olRestrictedItems = olInBox.Items.Restrict(strFilter1 & " And " & strFilter2)
    
    'Set folder to move emails to
    Set olMoveToFolder = olNS.Folders("DailyMail").Folders("Daily Mailers")
    
    'Loop through each item in inbox, move items that meet the criteria to their
    'respective folder, collect relevant data in html table format, and keep track of
    'number of emails that met criteria and were moved
    strHtmlContents = ""
    emailCount = 0
    For itemIndex = olRestrictedItems.Count To 1 Step -1
        Set olItem = olRestrictedItems(itemIndex)
        If TypeName(olItem) = "MailItem" Then
            If olItem.SenderEmailAddress = "janedoe@example.com" Then 'change the email address accordingly
                If UCase(Left(olItem.Subject, 3)) <> "RE:" And UCase(Left(olItem.Subject, 3)) <> "FW:" Then
                    strHtmlContents = strHtmlContents & vbCrLf & "<tr>"
                    strHtmlContents = strHtmlContents & vbCrLf & "<td>" & olItem.Subject & "</td>"
                    strHtmlContents = strHtmlContents & vbCrLf & "<td>" & olItem.ReceivedTime & "</td>"
                    strHtmlContents = strHtmlContents & vbCrLf & "</tr>"
                    olItem.Move olMoveToFolder
                    emailCount = emailCount + 1
                End If
            End If
        End If
    Next itemIndex
    
    'If one or more emails met the criteria and were moved, add the necessary html code
    'to complete the formatting for the html table, and then create a new email with the data
    'collected and send it to the specified user
    If emailCount > 0 Then
        strHtmlBody = "<table width=100% border=1 cellpadding=3>"
        strHtmlBody = strHtmlBody & "<tr>"
        strHtmlBody = strHtmlBody & vbCrLf & "<th width=70% align=left>Subject</th>"
        strHtmlBody = strHtmlBody & vbCrLf & "<th align=left>Received Time</th>"
        strHtmlBody = strHtmlBody & vbCrLf & "</tr>"
        strHtmlBody = strHtmlBody & vbCrLf & strHtmlContents
        strHtmlBody = strHtmlBody & vbCrLf & "</table>"
        Set olMail = olApp.CreateItem(0)
        With olMail
            .To = "johnsmith@example.com" 'change the email address accordingly
            .Subject = "List of emails received" 'change the subject accordingly
            .htmlbody = "<p>Number of emails received: " & emailCount & "</p>"
            .htmlbody = .htmlbody & strHtmlBody
            .display 'to display email instead of sending it
            '.send 'to send email instead of displaying it
        End With
        MsgBox emailCount & " email(s) received and moved, and report sent.", vbInformation
    Else
        MsgBox "No emails received.", vbInformation
    End If
    
exitHandler:
    'If Outlook was started, close it
    'Uncomment next 3 lines when emails are actual being sent
    'If blnStarted Then
        'olApp.Quit
    'End If
    
    Set olApp = Nothing
    Set olNS = Nothing
    Set olInBox = Nothing
    Set olRestrictedItems = Nothing
    Set olMoveToFolder = Nothing
    Set olItem = Nothing
    Set olMail = Nothing
    
    Exit Sub
    
errHandler:
    MsgBox "Error " & Err.Number & ":" & vbCrLf & vbCrLf & Err.Description, vbCritical, "Error"
    Resume exitHandler
    
End Sub
```

Hope this helps!


----------



## Pranesh (May 31, 2019)

Domenic said:


> I've only had a chance to address [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1 [/URL]  and [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=2]#2 [/URL] , so I suggested you start a new thread for help with #3  and #4 .  Here's the code, which has been amended to address [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=1]#1 [/URL]  and [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=2]#2 [/URL] ...
> 
> 
> ```
> ...



Hi Domenic,


Thank you so much for your help till now. The code works perfectly for the #1  & #2 . I will create a new thread for the remaining. 


Meanwhile I'm trying to just copy the table which is defined as strHtmlbody to the excel sheet where i run this. But im unable to paste it. Below is the code which i use. Any suggestions to work it out.


```
tw.Activate
        Sheet1.Select
        Range("A3").Select
        Selection.Value = strHtmlBody
```


----------



## Domenic (May 31, 2019)

I'm not sure what you mean by "unable to paste it".  If you want to copy the table itself to Excel, without the html code, try...


```
olMail.GetInspector.WordEditor.Tables(1).Range.Copy
Sheet1.Paste Sheet1.Range("A3")
```


----------



## Pranesh (Jun 3, 2019)

Domenic said:


> I'm not sure what you mean by "unable to paste it".  If you want to copy the table itself to Excel, without the html code, try...
> 
> 
> ```
> ...



Hi Domenic,


This is what i expected. Your code works perfect. You made my work easier with help of your code. Thank you so much for all your time and help till now. I hope and wish your help will continue when again i post a new thread.


----------



## Domenic (Jun 3, 2019)

You're very welcome!

Cheers!


----------



## Pranesh (Jun 26, 2019)

Domenic said:


> You're very welcome!
> 
> Cheers!



Hi Domenic,


Sorry to disturb you again.


Everything is working fine in this Macro. I have one small correction to be made. Please help me if you can.


Now if i give the date as 6/26/2019  the macro pulls all the emails received on that datel. I need a correction here. If i give date as 6/26/2019 1:00 PM it should move the mails received on 6/26/2019 from 12:00 AM to till 1:00 PM. If i update date as 6/26/2019 2:00 PM then it should move the mails received on 6/26/2019 from 2:00 PM to 6/26/2019 11:59 PM.

Thanks in advance for your help.


----------



## Domenic (Jun 26, 2019)

Let's say that A1 contains 6/26/2019 1:00 PM.  To get the starting time of 6/26/2019 12:00 AM, you would use the Int function...



```
Int(Worksheets("Sheet1").Range("A1").Value)
```


And for the ending time of 6/26/2019 1:00 PM, you would simply use...



```
Worksheets("Sheet1").Range("A1").Value
```


Therefore your filters would be as follows...



```
'Filter items for date specified in cell A1
    strFilter1 = "[ReceivedTime] >= '" & Format(Int(Worksheets("Sheet1").Range("A1").Value), "ddddd h:nn AMPM") & "'"
    strFilter2 = "[ReceivedTime] < '" & Format(Worksheets("Sheet1").Range("A1").Value, "ddddd h:nn AMPM") & "'"
```


Hope this helps!


----------



## Pranesh (Jun 27, 2019)

Domenic said:


> Let's say that A1 contains 6/26/2019 1:00 PM.  To get the starting time of 6/26/2019 12:00 AM, you would use the Int function...
> 
> 
> 
> ...




Hi Domenic,


Thank you so much for your response and help.


I applied the code you provided it is moving emails received till 1:00 AM.


I think i didnt clearly explain what im looking for. Actually i will run this macro twice a day. Morning between 7 to 11 i will receive a set of emails and between 3:00PM to 7:00PM i will receive few set of emails so i run this twice a day.


If im on leave i will run it the next day by updating previous date in Range("A1") and the macro will move all the emails received through out the day and thats is why i need a split in moving this email.


My sugesstion is if i have date as 6/27/2019 in Range("A1") and "Morning" in Range("A2") then macro should move the emails received between 6/27/2019 12:00 AM to 02:00 PM. If if update Range("A2") as "Evening" then macro should move emails received on 6/27/2019 between 02:01 PM to 11:59 PM. 

Thanks again for your help.


----------



## Domenic (Jun 27, 2019)

In that case, try the following...


```
'Filter items for date specified in cell A1
    If UCase(Worksheets("Sheet1").Range("A2")) = "MORNING" Then
        strFilter1 = "[ReceivedTime] >= '" & Format(Worksheets("Sheet1").Range("A1").Value, "ddddd h:nn AMPM") & "'"
        strFilter2 = "[ReceivedTime] < '" & Format(Worksheets("Sheet1").Range("A1").Value + TimeValue("2:00 PM"), "ddddd h:nn AMPM") & "'"
    ElseIf UCase(Worksheets("Sheet1").Range("A2")) = "EVENING" Then
        strFilter1 = "[ReceivedTime] >= '" & Format(Worksheets("Sheet1").Range("A1").Value + TimeValue("2:00 PM"), "ddddd h:nn AMPM") & "'"
        strFilter2 = "[ReceivedTime] < '" & Format(Worksheets("Sheet1").Range("A1").Value + 1, "ddddd h:nn AMPM") & "'"
    End If
```


----------



## Pranesh (May 2, 2019)

Hi,

I receive 20 to 25 emails a day from a common mail box daily to my Outlook 2016. I will then move those emails to a personal folder named "Daily email1" & "Daily email 2" based on email subject. 

I want this to be automated. Whenever I get those emails I want a button to run a code which should move those emails to respective folder based on email subject. Once that is done I need Macro to prepare a report to say how many emails has been received from that email box and need a list of email subject with the mail received time in body of the email which should be sent to a user.

I searched online for VBA codes but no luck. Can someone help me.


----------



## Pranesh (Jun 28, 2019)

Domenic said:


> In that case, try the following...
> 
> 
> ```
> ...




Hi Domenic,


Your genius. It worked out perfectly. Thanks a ton for all your help.


----------



## Domenic (Jun 28, 2019)

You're very welcome!

Cheers!


----------

