Solved

fixing previous solution

Posted on 2013-01-12
10
207 Views
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
0
Comment
Question by:JaseSt
  • 6
  • 4
10 Comments
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
Is it when you activvate email into tab option ? is it for specific emails or all of them ?
gowflow
0
 

Author Comment

by:JaseSt
Comment Utility
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.
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
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
gowflow
0
 

Author Comment

by:JaseSt
Comment Utility
yes, put the Processed to Green and the not processed to Red
0
 
LVL 29

Accepted Solution

by:
gowflow earned 500 total points
Comment Utility
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
    
    
    Do
    '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
        Else
            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"
            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
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

Errhandler1:
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.

gowflow
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 29

Expert Comment

by:gowflow
Comment Utility
Any chance to hv tired it out ?
gowflow
0
 

Author Closing Comment

by:JaseSt
Comment Utility
Works perfectly, gowflow! Thank you!
0
 
LVL 29

Expert Comment

by:gowflow
Comment Utility
gr8. Anything else let me know in here.
gowflow
0
 

Author Comment

by:JaseSt
Comment Utility
And if you're willing, this one:

http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/Excel/Q_27995435.html

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

Expert Comment

by:gowflow
Comment Utility
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.
gowflow
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

A2 = A1 That kind of cell reference is relative.  If you copy it from A2 to B2, then B2 will get this: B2 = B1 That's all fine and good, but if you then insert a new row above row 2, you'll find: A3 = A1 B3 = B1 This is intentional. …
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…

762 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

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now