Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people, just like you, are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions

fixing previous solution

Posted on 2013-01-12
Last Modified: 2013-01-15
The attached scrubbed workbook has a macro that imports emails from Outlook into different sheets when the credit card number in the email = cell D2. It use to highlight the category of the email red or green if not processed or processed.

Since I switched over to Outlook 2010 (had Outlook 2007 before) it no longer puts a color to indicate the status. It does, however  say Not Processed or Processed. I would like it to use colors instead as it is much easier to see.

I also attach a screenshot at what the Visa card is doing (correctly) and what the Mastercard workbook is doing.MC-Spreadsheet-scrubbed.xlsmmcvisa
Question by:JaseSt
  • 6
  • 4
LVL 29

Expert Comment

ID: 38770527
Is it when you activvate email into tab option ? is it for specific emails or all of them ?

Author Comment

ID: 38770533
it's when I activate the email into tabs option - that's when it's supposed to go through the email, extract the data and import it into the spreadsheet, then highlight the emails either red (for not processed) and green (for processed)

However, keep in mind and you may remember, that a pass with the visa function will leave mc emails red which then when picked up the mc function will turn them green.
LVL 29

Expert Comment

ID: 38770537
Well the function actually put them as Processed and Not Processed in MC so what do you want to do ? Shall we put the Processed to Green and the not processed to Red or .. ?
U tell me
Free Tool: Postgres Monitoring System

A PHP and Perl based system to collect and display usage statistics from PostgreSQL databases.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.


Author Comment

ID: 38770545
yes, put the Processed to Green and the not processed to Red
LVL 29

Accepted Solution

gowflow earned 500 total points
ID: 38770553
ok here it is:

1) Make a copy of ur latest MC file give it a new name.
2) Goto VBA chose to view 1 sub at a time locate the Sub LocateEMailsToTabNew and delete it.
3) Paste the below code after an end sub

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, K As Long, L As Long
Dim FMonitor, FTransfer
Dim tmpBody, tmpTransferLine
Dim TransAmount As Double
Dim EmailType As String

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' or ([Subject] >= 'Bank Transfer # ' and [Subject] <= 'Bank Transfer #z') or [Subject] = 'Liberty Reserve Payment Received'")
VisaItems.Sort "receivedtime", False
Set VItem = VisaItems.Find("[Subject] = 'Payment Received' or ([Subject] >= 'Bank Transfer # ' and [Subject] <= 'Bank Transfer #z') or [Subject] = 'Liberty Reserve Payment Received'")

If Not VItem Is Nothing Then
    TotItems = VisaItems.count
    I = 1
    'For Each VItem In VisaItems
        wsMain.Range("L" & CRow) = "Locate Emails - VisaItems: " & I & " " & VItem.SenderEmailAddress & " " & VItem
        CRow = CRow + 1
        Set objMail = VItem
        Body = objMail.Body
        Etime = objMail.ReceivedTime
        '---> Determine Email Type
        Select Case objMail.Subject
            Case "Payment Received"
                EmailType = "Payment"
            Case "Fwd: Liberty Reserve Payment Received"
                EmailType = "Liberty"
            Case Is >= "Bank Transfer # ", Is <= "Bank Transfer #z", Is <> "Fwd: Liberty Reserve Payment Received"
                EmailType = "Transfer"
        End Select
        '---> Depending on Type of Mail route Import
        If InStr(1, objMail.Subject, "Bank Transfer #") <> 0 Then
            '---> Process Bank Transfer Emails
            tmpBody = Split(objMail.Body, Chr(10))
            st = "Bank Transfer"
            For K = 0 To UBound(tmpBody)
                If InStr(1, tmpBody(K), "Bank Transfer #") <> 0 And InStr(1, tmpBody(K), "for USD") <> 0 Then
                    tmpTransferLine = Split(Right(tmpBody(K), Len(tmpBody(K)) - InStr(1, tmpBody(K), "for USD") + 1), " ")
                    For L = 0 To UBound(tmpTransferLine)
                        If IsNumeric(tmpTransferLine(L)) Then
                            TransAmount = tmpTransferLine(L)
                            MaxRow = Sheets("MC Heritage Balance").Range("B1048576").End(xlUp).Row + 1
                            Sheets("MC Heritage Balance").Range("B" & MaxRow) = TransAmount
                            Sheets("MC Heritage Balance").Range("C" & MaxRow) = Etime
                            Exit For
                        End If
                    Next L
                    If st = "Bank Transfer" Then
                        st = ""
                        Exit For
                    End If
                End If
            Next K
            st = ImportData5New(Body, Etime, MaxRow + 1, EmailType)
        End If
        '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"
            wsMain.Range("L" & CRow) = "Locate Emails - Not Imported: <" & st & "> "
            CRow = CRow + 2
            'objMail.Move objFolderToTransfer
            'VItem.Move objFolderToTransfer
            EmailMoved = EmailMoved + 1
            VItem.Categories = "Green Category"
            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
End If

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

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

End Sub

Open in new window

4) SAVE and EXIT
5) Try it. Make sure on the same emails you try both this function for the Visa file and the MC file and see their repercussion and if all is ok.

LVL 29

Expert Comment

ID: 38773418
Any chance to hv tired it out ?

Author Closing Comment

ID: 38774107
Works perfectly, gowflow! Thank you!
LVL 29

Expert Comment

ID: 38774952
gr8. Anything else let me know in here.

Author Comment

ID: 38776969
And if you're willing, this one:


Has to do with importing data into Visa Consolidated from the Visa workbook.
LVL 29

Expert Comment

ID: 38777780
Do not see any Sub for that was developped for that new question. If u hv it pls post it so I can see it.

Featured Post

Announcing the Most Valuable Experts of 2016

MVEs are more concerned with the satisfaction of those they help than with the considerable points they can earn. They are the types of people you feel privileged to call colleagues. Join us in honoring this amazing group of Experts.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Excel if statement 3 15
Excel - INDEX MATCH error 13 23
need formula to  count the number of letters in the 2nd word of excel value 3 36
Excel formula - data format 5 17
Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
Many functions in Excel can make decisions. The most simple of these is the IF function: it returns a value depending on whether a condition you describe is true or false. Once you get the hang of using the IF function, you will find it easier to us…

809 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question