Highlighting or marking an email after processing

What do you mean by "after processing"? How are they "processed"? By a macro?

If they are processed manually, just change the fill color of the cells that were processed. If they were processed by a macro, change the macro so that after processing, it changes the fill color of thoose cells.

what column do you want to flag in green ? and if you do then you will not be able to see the diffrence with the past ones !
gowflow

I am trying to decode what you want and presume,
you need a new button that you can activate once you are done checking the imported emails and all is ok then you would need the whole new bunch to be colored in green ?

If this is what you want pls let me know what worksheet are we talking about ? Single customers ? or MCR /HMF Account ?

gowflow  

I don't want the spreadsheet flagged, but the email, as attached, to be marked once processed successfully.

We're talking about all emails that are imported into a spreadsheet,  starting with the mastercard imports.

So you wanted to be flaged as soon as imported ? not a separate button right ?
gowflow

Ok you mentioned Green so here it is.
Delete the present Sub ... and replace it by the below one.
Let me know.
gowflow

Sub LocateEmailsToTabsNew()
On Error GoTo Errhandler1

Dim FoundIt As Boolean
Dim Body As String
Dim MaxRow As Long, EmailMoved As Long, EmailNotMoved As Long, TotItems As Long
Dim I As Long, J As Long
Dim FMonitor, FTransfer

Set objOutlook = CreateObject("Outlook.application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
'Set objFolder = objNameSpace.Folders(gstFolderToMonitor)

FMonitor = Split(Mid(gstFolderToMonitor, 2), "\")
If Not SetMonitorFolder(FMonitor) Then Exit Sub
wsMain.Range("L" & CRow) = "Locate Emails - FMonitor: " & objFolderToMonitor
CRow = CRow + 1

FTransfer = Split(Mid(gstFolderToTransfer, 2), "\")
If Not SetTransferFolder(FTransfer) Then Exit Sub
wsMain.Range("L" & CRow) = "Locate Emails - FTransfer: " & objFolderToTransfer
CRow = CRow + 1

Dim VItem As Outlook.MailItem

Set VisaItems = objFolderToMonitor.items.Restrict("[Subject] = 'Payment Received'")
VisaItems.Sort "receivedtime", False
Set VItem = VisaItems.Find("[Subject] = 'Payment Received'")
TotItems = VisaItems.count
I = 1

Do
'For Each VItem In VisaItems
    wsMain.Range("L" & CRow) = "Locate Emails - VisaItems: " & I & " " & VItem.SenderEmailAddress & " " & VItem
    CRow = CRow + 1

    Set objMail = VItem
    ' use Instr here to check subject or body
    'MsgBox objMail.Subject
    Body = objMail.Body
    ETime = objMail.ReceivedTime
    'MaxRow = wsVisa.UsedRange.Rows.count
    'MaxRow = wsVisa.Range("B1048576").End(xlUp).Row
    'Application.EnableEvents = False
    st = ImportData5New(Body, ETime, MaxRow + 1)
    'Application.EnableEvents = True
    If st <> "" Then
        MsgBox ("Email From: [" & st & "] not imported")
        EmailNotMoved = EmailNotMoved + 1
        wsMain.Range("L" & CRow) = "Locate Emails - Not Imported: <" & st & "> "
        CRow = CRow + 2

    Else
        'objMail.Move objFolderToTransfer
        'VItem.Move objFolderToTransfer
        EmailMoved = EmailMoved + 1
        VItem.Categories = "Green Category"
        VItem.Save
        wsMain.Range("L" & CRow) = "Locate Emails - Imported and Not Moved: <" & VItem.SenderEmailAddress & "> "
        CRow = CRow + 2

    End If
    I = I + 1
    Set VItem = VisaItems.FindNext
Loop Until I = TotItems + 1

MsgBox ("Total Emails processed from '" & objFolderToMonitor & "' " & TotItems & Chr(10) _
    & "Total Emails Imported and Not Moved: " & EmailMoved & Chr(10) _
    & "Total Emails Not Imported: " & EmailNotMoved & " and kept in '" & objFolderToMonitor & "'" _
    & "Imported Emails were kept in : '" & objFolderToMonitor & "'")
wsMain.Range("L" & CRow) = ("Locate Emails - Total Emails processed from '" & objFolderToMonitor & "' " & TotItems _
    & "Total Emails Imported and Not Moved: " & EmailMoved _
    & "Total Emails Not Imported: " & EmailNotMoved & " and kept in '" & objFolderToMonitor & "'" _
    & "Imported Emails were kept in: '" & objFolderToMonitor & "'")
CRow = CRow + 1

Exit Sub

Errhandler1:
MsgBox (Error(err))
wsMain.Range("L" & CRow) = "Locate Emails - Error: <" & Error(err) & "> Item " & VItem
CRow = CRow + 1
Resume Next

End Sub

Select allOpen in new window

Thank you, but. well... not exactly what I was hoping for. I was hoping the message flag would turn green, instead a Green Category bar was created, okay I guess. Please see attached.

If making the flag green is an issue, then can you just have it turn on like in the attached image? Or maybe it's better or more doable if when an email is not successfully imported the red flag turns on?

The reason I'd like the flag turned on is because I can just glance at the list of emails without having to click on each of them to see which ones imported successfully.

Can this be done? If not, let me know. Thank you!

Did the message in the lookup folder like here in your pic the left pane did have a green beside it ? it seems no !!! coz I made it and the test I did showed the emails were also flaged green like here attached I can flag the ones who did not go thru by red as well. Are you using Outlook 2003 or 2007 ?
My test in this pic is for Ooutlook 2007
gowflow
Green-Flag.jpg

No, I do not have those green squares or blank squares at all. I have Outlook 2007. Maybe there is a setting I need to turn on?

Also, when I transferred the email to my EP Wires folder, the Green Category bar was gone. I'd like it to stay on, if possible.

Ok fine here it is

You need to do some settings in outlook I have taken some snapshot so it could be easier.

1) You need to drag the preview window to the right just enough so you can see the fileds on top like the image here.

 
2) You should right click on any of the existing fields and choose Field chooser

 
3) then look for the field Categories and drag it to where you want it to be I put it beside the flag col

 
4) You should end up with something like this

 
Drag the preview window back again to the size you need and it will still keep Categories and flag showing.

I added the red flag for those emails not imported.
gowflow

Sub LocateEmailsToTabsNew()
On Error GoTo Errhandler1

Dim FoundIt As Boolean
Dim Body As String
Dim MaxRow As Long, EmailMoved As Long, EmailNotMoved As Long, TotItems As Long
Dim I As Long, J As Long
Dim FMonitor, FTransfer

Set objOutlook = CreateObject("Outlook.application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
'Set objFolder = objNameSpace.Folders(gstFolderToMonitor)

FMonitor = Split(Mid(gstFolderToMonitor, 2), "\")
If Not SetMonitorFolder(FMonitor) Then Exit Sub
wsMain.Range("L" & CRow) = "Locate Emails - FMonitor: " & objFolderToMonitor
CRow = CRow + 1

FTransfer = Split(Mid(gstFolderToTransfer, 2), "\")
If Not SetTransferFolder(FTransfer) Then Exit Sub
wsMain.Range("L" & CRow) = "Locate Emails - FTransfer: " & objFolderToTransfer
CRow = CRow + 1

Dim VItem As Outlook.MailItem

Set VisaItems = objFolderToMonitor.items.Restrict("[Subject] = 'Payment Received'")
VisaItems.Sort "receivedtime", False
Set VItem = VisaItems.Find("[Subject] = 'Payment Received'")
TotItems = VisaItems.count
I = 1

Do
'For Each VItem In VisaItems
    wsMain.Range("L" & CRow) = "Locate Emails - VisaItems: " & I & " " & VItem.SenderEmailAddress & " " & VItem
    CRow = CRow + 1

    Set objMail = VItem
    ' use Instr here to check subject or body
    'MsgBox objMail.Subject
    Body = objMail.Body
    ETime = objMail.ReceivedTime
    'MaxRow = wsVisa.UsedRange.Rows.count
    'MaxRow = wsVisa.Range("B1048576").End(xlUp).Row
    'Application.EnableEvents = False
    st = ImportData5New(Body, ETime, MaxRow + 1)
    'Application.EnableEvents = True
    If st <> "" Then
        MsgBox ("Email From: [" & st & "] not imported")
        EmailNotMoved = EmailNotMoved + 1
        VItem.Categories = "Red Category"
        VItem.Save
        wsMain.Range("L" & CRow) = "Locate Emails - Not Imported: <" & st & "> "
        CRow = CRow + 2

    Else
        'objMail.Move objFolderToTransfer
        'VItem.Move objFolderToTransfer
        EmailMoved = EmailMoved + 1
        VItem.Categories = "Green Category"
        VItem.Save
        wsMain.Range("L" & CRow) = "Locate Emails - Imported and Not Moved: <" & VItem.SenderEmailAddress & "> "
        CRow = CRow + 2

    End If
    I = I + 1
    Set VItem = VisaItems.FindNext
Loop Until I = TotItems + 1

MsgBox ("Total Emails processed from '" & objFolderToMonitor & "' " & TotItems & Chr(10) _
    & "Total Emails Imported and Not Moved: " & EmailMoved & Chr(10) _
    & "Total Emails Not Imported: " & EmailNotMoved & " and kept in '" & objFolderToMonitor & "'" _
    & "Imported Emails were kept in : '" & objFolderToMonitor & "'")
wsMain.Range("L" & CRow) = ("Locate Emails - Total Emails processed from '" & objFolderToMonitor & "' " & TotItems _
    & "Total Emails Imported and Not Moved: " & EmailMoved _
    & "Total Emails Not Imported: " & EmailNotMoved & " and kept in '" & objFolderToMonitor & "'" _
    & "Imported Emails were kept in: '" & objFolderToMonitor & "'")
CRow = CRow + 1

Exit Sub

Errhandler1:
MsgBox (Error(err))
wsMain.Range("L" & CRow) = "Locate Emails - Error: <" & Error(err) & "> Item " & VItem
CRow = CRow + 1
Resume Next

End Sub

Select allOpen in new window

doing as you state to insert categories, I see no box. Is there something else I need to do?

click on the down arrow beside categories what do you get some activate or something like this ??
I don't hv a down arrow I must have used it when I first installed categories !!
gowflow

clicking on the down arrow just allows sorting based on Categories. Formatting the Categories column only gives me the option of text.

run now the test and see if the categories shows
gowflow

yes, now they showed up as in screenshot, but when I click on the message in the  Inbox pane they go away. I'd like them to stay on, if possible.

And it is interesting that those emails that were to go to the Visa spreadsheet became a red category when I was thinking that only if the emails for the mastercard sheet that didn't process for some reason (couldn't find the sheet) would turn red. Or... they would turn green once processed by the Visa spreadsheet. I guess that would work.

In any event, they need to stay green when I move them to my EP Wires folder

"Or... they would turn green once processed by the Visa spreadsheet. I guess that would work."

The reason I state this as a doable option is because I would like this same function for the Visa spreadsheet email imports.

So... it's okay if after the first pass all those that don't process get a red category, but after passes by the visa and mastercard import function those that are read should turn green once processed, unless of course, if they do not import. Hopefully this isn't confusing. Thank you.

Note if you click on the message ... the categories won't reset BUT if you click on the Categories field of the message then YES the categories will reset ! so all depends where you click !!! :)

I have not updated this routine in the Visa file though but as it turns red when you import mastercard ... it if not updated in the Visa file how come they turned Green then ? By miracle ... or you put the code yourself in Visa file ???
gowflow

About the Visa issue and running the procedure on items that were already there you rose an important issue that I fixed for future implementation of the routine in Visa so it is working from both ends and we don't get red's when we don't need to.

This is the final version bearing in mind application in the Visa wb that could mean running 2 passes on the same emails.

pls replace corrent sub in mastercard file with this one. you should not see a diffrence now that you run only the mastercard routine but once implemented in the visa file as well the old routine would reset the green flags to red (which obviously is something we do not want and that is addressed in this fix)

gowflow

Sub LocateEmailsToTabsNew()
On Error GoTo Errhandler1

Dim FoundIt As Boolean
Dim Body As String
Dim MaxRow As Long, EmailMoved As Long, EmailNotMoved As Long, TotItems As Long
Dim I As Long, J As Long
Dim FMonitor, FTransfer

Set objOutlook = CreateObject("Outlook.application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
'Set objFolder = objNameSpace.Folders(gstFolderToMonitor)

FMonitor = Split(Mid(gstFolderToMonitor, 2), "\")
If Not SetMonitorFolder(FMonitor) Then Exit Sub
wsMain.Range("L" & CRow) = "Locate Emails - FMonitor: " & objFolderToMonitor
CRow = CRow + 1

FTransfer = Split(Mid(gstFolderToTransfer, 2), "\")
If Not SetTransferFolder(FTransfer) Then Exit Sub
wsMain.Range("L" & CRow) = "Locate Emails - FTransfer: " & objFolderToTransfer
CRow = CRow + 1

Dim VItem As Outlook.MailItem

Set VisaItems = objFolderToMonitor.items.Restrict("[Subject] = 'Payment Received'")
VisaItems.Sort "receivedtime", False
Set VItem = VisaItems.Find("[Subject] = 'Payment Received'")
TotItems = VisaItems.count
I = 1

Do
'For Each VItem In VisaItems
    wsMain.Range("L" & CRow) = "Locate Emails - VisaItems: " & I & " " & VItem.SenderEmailAddress & " " & VItem
    CRow = CRow + 1

    Set objMail = VItem
    ' use Instr here to check subject or body
    'MsgBox objMail.Subject
    Body = objMail.Body
    ETime = objMail.ReceivedTime
    'MaxRow = wsVisa.UsedRange.Rows.count
    'MaxRow = wsVisa.Range("B1048576").End(xlUp).Row
    'Application.EnableEvents = False
    st = ImportData5New(Body, ETime, MaxRow + 1)
    'Application.EnableEvents = True
    If st <> "" Then
        MsgBox ("Email From: [" & st & "] not imported")
        EmailNotMoved = EmailNotMoved + 1
        If VItem.Categories <> "Green Category" Then VItem.Categories = "Red Category"
        VItem.Save
        wsMain.Range("L" & CRow) = "Locate Emails - Not Imported: <" & st & "> "
        CRow = CRow + 2

    Else
        'objMail.Move objFolderToTransfer
        'VItem.Move objFolderToTransfer
        EmailMoved = EmailMoved + 1
        VItem.Categories = "Green Category"
        VItem.Save
        wsMain.Range("L" & CRow) = "Locate Emails - Imported and Not Moved: <" & VItem.SenderEmailAddress & "> "
        CRow = CRow + 2

    End If
    I = I + 1
    Set VItem = VisaItems.FindNext
Loop Until I = TotItems + 1

MsgBox ("Total Emails processed from '" & objFolderToMonitor & "' " & TotItems & Chr(10) _
    & "Total Emails Imported and Not Moved: " & EmailMoved & Chr(10) _
    & "Total Emails Not Imported: " & EmailNotMoved & " and kept in '" & objFolderToMonitor & "'" _
    & "Imported Emails were kept in : '" & objFolderToMonitor & "'")
wsMain.Range("L" & CRow) = ("Locate Emails - Total Emails processed from '" & objFolderToMonitor & "' " & TotItems _
    & "Total Emails Imported and Not Moved: " & EmailMoved _
    & "Total Emails Not Imported: " & EmailNotMoved & " and kept in '" & objFolderToMonitor & "'" _
    & "Imported Emails were kept in: '" & objFolderToMonitor & "'")
CRow = CRow + 1

Exit Sub

Errhandler1:
MsgBox (Error(err))
wsMain.Range("L" & CRow) = "Locate Emails - Error: <" & Error(err) & "> Item " & VItem
CRow = CRow + 1
Resume Next

End Sub

Select allOpen in new window

Worked great turning the categories to green but it didn't turn the unprocessed to red. Wasn't it supposed to do that?

yes it should ! but unless they were primarly Green then it won't. If they are not grenn and are not Imported they should turn Red
gowflow

I just tried it on a newly arrived batch and the only thing that happened, which worked nicely, was turning the successfully processed to green. nothing else. the other three that came in did not turn red. Now, I wouldn't need the emails for Visa import to turn red (only when that script is set up) only those that are supposed to go to the Mastercard spreadsheet need to turn red if not successfully imported.

And how are you determining if an import was successful?

Thank you!

In the previous snapshot you posted ID: 36958163 you had some red items how come ?? now you claim that none are turning red!!!????
gowflow

that's right. none of them turned red this time. I'll try it again...

Ok, put three emails intended for Visa spreadsheet in Inbox, ran the Import function for Mastercard and they didn't turn red (not that I want them to) but before they did. And when I ran it earlier today, there was a MC email that had the wrong card number. It did not get imported, as it shouldn't have, but also did not turn red either.

ok wait let me try it here
gowflow

deleted code and reinserted the above. closed then reopened both excel and outlook. ran function same results. did not turn red. but did get the attached strange message. am going to restart my computer. maybe something going on that's getting in the way because it is taking a minute to go through my Inbox which is way longer than it use to.

Weell make sure as always to have both Transfer and monitor comboboxes set with valid outlook folders. It may happens that if you get an error code sometimes and save the workbook and re-open it it looses the outlook forlder and then you get all sorts of erros.
gowflow

shut down and restarted computer. made sure to select proper folders for all three options on Main. Ran import function. Immediately came up with dialogue box telling me first Visa email could not be imported. Clicked okay and then it ran for over a minute - doing what I don't know - then gave me the same OLE notification. Then went through the other two Visa emails, not importing them as it shouldn't but still no red category listing for those.

So... ran it again. This time no OLE notice but still no red category assigned to Visa emails. So... ran it again a 3rd time. Same results. No OLE but no red. Then removed those emails and brought in a few others. Ran code.  For some reason it seems to be taking a long time to process and still had same results.

Then brought over a Mastercard email to Inbox with wrong number. Did not import, which it shouldn't have but also did not turn it red. Then moved over a good Mastercard email. Ran code and it correctly highlighted in green. Bottom line: red categorization is not working for some reason. If can't get the red to work - as it did before - guess I'm okay with that as long as there isn't something else wrong with the code that could cause problems later.

Thank you.

I am afraid that you maybe deleted some lines you should have not to make sure

1) You should hv prior to deleteting the old macro Sub LocateEmailsToTabsNew() doubleclicked on module1
2) selected the left icon in the lower window to view 1 sub at a time
3) selected the Sub LocateEmailsToTabsNew()
4) delete the above sub
5) select all from the previous code attached and right click copy
6) pasted the code in module1 after any end sub
7) saved this workbook

if your not sure if you did that then pls take your last working copy save it in a new name and then re-do the above steps.

I surely don't know what the OLE error comes from.
gowflow

JaseSt

Some clarification. Reading your last post about emails put and red/green I have to mention hte following:

When we run the procedure for mastrcard in the monitored folder it is not ALL the emails that are processed it is only those where: "[Subject] = 'Payment Received'" all the rest of the emails where the subject is not payment received WILL NOT BE PROCESSED BY THIS ROUTINE HENCE will not be colored neither in green nor in red.

From the ones where "[Subject] = 'Payment Received'" then
1) the ones that are successfully imported are CC starting with 5 or HMF Account or all MCR will turn green
2) the ones that are not starting with CC 5 say CC = 4 will turn Red.

hope above clarifies.
gowflow

In my last post let me correct
From the ones where "[Subject] = 'Payment Received'" then
1) the ones that are successfully imported are CC starting with 5 or HMF Account or all MCR will turn green
2) the ones that are not starting with CC 5 say CC = 4 or not successfully imported from CC=5 (like sheet does not exist or not successfully imported from HMF / MCR ...) will turn Red.

gowflow

JaseST
I think I know what happened
You have by mistake DELETED the red category from Outlook !!! I did that now (for test and ran the code) and it is not coloring in Red the emails.

Do the following:
1) open Outlook
2) On hte Standard Toolbar on top the first icon is New then Print then couple of icons then Reply, Reply All then Forward then the next icon is a square with 4 colors (Red Yellow Green Blue) click on it and it you will see the available categories (for sure it is missing the Red) if yes then click on the same square in the list called All Categories it will open a window with the available categories.
3) Click on New it will open a window showing a color (most probably the red color, if not click on the arrow from the dropdown colors and choose the red color) then in Name type Red Category (respect the caps) press ok and it will put a click on the red category remove it and press ok.
4) You should now see all the emails that were imported that turned Red (if not then run the macro again)

Let me know.
gowflow

that may be it, but I don't see that icon in my toolbar and haven't been able to find out how to activate it.

no problem
display your emails in the monitor folder where you got some green categories
right click on an email that is green on the Category item on the color green and choose from the list All categories (you will see then the square with 4 colors) and from there follow my previous post.
gowflow

That worked, thank you. It did miss one, but I'm thinking that was a fluke and will monitor as I go along.

What happened is that I had changed the name of the categories to Processed and Not Processed, not knowing that would cause problems. It works now, thank you. But that being said, where can I change
the name from Red Category and Green Category to Processed and Not Processed and have it still work? In the code somewhere, I presume.

Once again, true expert help from gowflow. Thank you!!

Next up, as you may have guessed, is doing the same thing for imports to the Visa spreadsheet, but not for Western Union Imports - not necessary. Only for Import Emails button. Then back to Western Union Imports. There's a number of issues I need straightened out that builds upon what you've done already.

I'll post it here as a related question as you've mentioned to let you know.

Thanks again, gowflow. You're an Excel Master!

Here is it forr Processed = Green color and Not Processed = Red Color
You will need to change the Categories Name to match these 2 to work Better, I will suggest you leave the original ones as is and Create 2 new ones with these definitions.

Please replace the old code with the attached.
Thanks for you nice comments as usual and for the grade as well.
gowflow

Sub LocateEmailsToTabsNew()
On Error GoTo Errhandler1

Dim FoundIt As Boolean
Dim Body As String
Dim MaxRow As Long, EmailMoved As Long, EmailNotMoved As Long, TotItems As Long
Dim I As Long, J As Long
Dim FMonitor, FTransfer

Set objOutlook = CreateObject("Outlook.application")
Set objNameSpace = objOutlook.GetNamespace("MAPI")
'Set objFolder = objNameSpace.Folders(gstFolderToMonitor)

FMonitor = Split(Mid(gstFolderToMonitor, 2), "\")
If Not SetMonitorFolder(FMonitor) Then Exit Sub
wsMain.Range("L" & CRow) = "Locate Emails - FMonitor: " & objFolderToMonitor
CRow = CRow + 1

FTransfer = Split(Mid(gstFolderToTransfer, 2), "\")
If Not SetTransferFolder(FTransfer) Then Exit Sub
wsMain.Range("L" & CRow) = "Locate Emails - FTransfer: " & objFolderToTransfer
CRow = CRow + 1

Dim VItem As Outlook.MailItem

Set VisaItems = objFolderToMonitor.items.Restrict("[Subject] = 'Payment Received'")
VisaItems.Sort "receivedtime", False
Set VItem = VisaItems.Find("[Subject] = 'Payment Received'")
TotItems = VisaItems.count
I = 1

Do
'For Each VItem In VisaItems
    wsMain.Range("L" & CRow) = "Locate Emails - VisaItems: " & I & " " & VItem.SenderEmailAddress & " " & VItem
    CRow = CRow + 1

    Set objMail = VItem
    ' use Instr here to check subject or body
    'MsgBox objMail.Subject
    Body = objMail.Body
    ETime = objMail.ReceivedTime
    'MaxRow = wsVisa.UsedRange.Rows.count
    'MaxRow = wsVisa.Range("B1048576").End(xlUp).Row
    'Application.EnableEvents = False
    st = ImportData5New(Body, ETime, MaxRow + 1)
    'Application.EnableEvents = True
    If st <> "" Then
        MsgBox ("Email From: [" & st & "] not imported")
        EmailNotMoved = EmailNotMoved + 1
        If VItem.Categories <> "Processed" Then VItem.Categories = "Not Processed"
        VItem.Save
        wsMain.Range("L" & CRow) = "Locate Emails - Not Imported: <" & st & "> "
        CRow = CRow + 2

    Else
        'objMail.Move objFolderToTransfer
        'VItem.Move objFolderToTransfer
        EmailMoved = EmailMoved + 1
        VItem.Categories = "Processed"
        VItem.Save
        wsMain.Range("L" & CRow) = "Locate Emails - Imported and Not Moved: <" & VItem.SenderEmailAddress & "> "
        CRow = CRow + 2

    End If
    I = I + 1
    Set VItem = VisaItems.FindNext
Loop Until I = TotItems + 1

MsgBox ("Total Emails processed from '" & objFolderToMonitor & "' " & TotItems & Chr(10) _
    & "Total Emails Imported and Not Moved: " & EmailMoved & Chr(10) _
    & "Total Emails Not Imported: " & EmailNotMoved & " and kept in '" & objFolderToMonitor & "'" _
    & "Imported Emails were kept in : '" & objFolderToMonitor & "'")
wsMain.Range("L" & CRow) = ("Locate Emails - Total Emails processed from '" & objFolderToMonitor & "' " & TotItems _
    & "Total Emails Imported and Not Moved: " & EmailMoved _
    & "Total Emails Not Imported: " & EmailNotMoved & " and kept in '" & objFolderToMonitor & "'" _
    & "Imported Emails were kept in: '" & objFolderToMonitor & "'")
CRow = CRow + 1

Exit Sub

Errhandler1:
MsgBox (Error(err))
wsMain.Range("L" & CRow) = "Locate Emails - Error: <" & Error(err) & "> Item " & VItem
CRow = CRow + 1
Resume Next

End Sub

Select allOpen in new window