[Webinar] Streamline your web hosting managementRegister Today

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 257
  • Last Modified:

fixing previous solution

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
JaseSt
Asked:
JaseSt
  • 6
  • 4
1 Solution
 
gowflowCommented:
Is it when you activvate email into tab option ? is it for specific emails or all of them ?
gowflow
0
 
JaseStAuthor Commented:
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
 
gowflowCommented:
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
Receive 1:1 tech help

Solve your biggest tech problems alongside global tech experts with 1:1 help.

 
JaseStAuthor Commented:
yes, put the Processed to Green and the not processed to Red
0
 
gowflowCommented:
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
 
gowflowCommented:
Any chance to hv tired it out ?
gowflow
0
 
JaseStAuthor Commented:
Works perfectly, gowflow! Thank you!
0
 
gowflowCommented:
gr8. Anything else let me know in here.
gowflow
0
 
JaseStAuthor Commented:
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
 
gowflowCommented:
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

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

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