Solved

Obtaining data from Outlook Emails

Posted on 2011-09-14
35
422 Views
Last Modified: 2012-05-12
This is for gowflow as he is quite familiar with this spreadsheet.

Currently when an email comes in there is a script for the Mastercard spreadsheet that goes through and inputs values into the individual sheets. These are deposits from our individual cardholders.

However, I also have emails that come in with deposits from our resellers which are the MCR pages and the HMF Account page, as well as a few others. Here's are two example emails:


Dear Client,
You have received a Payment.
From: HMF Limited
Amount: USD 2140.01
Please log in and check your USD-account statement for more details.

(This is an automatic notification.)
Kind regards
Customer Support

2nd example:

Dear Client,
You have received a Payment.
From: eForex Staff
Amount: USD 3969.91
Please log in and check your USD-account statement for more details.

(This is an automatic notification.)
Kind regards
Customer Support

When an email comes in that has 'Payment Received' as the subject and has From: 'eForex Staff', or eForex Customers', or 'Asiacom' in the body, here's what I need to happen to their individual sheets:

1. Put date of email in Col A
2. In Col F input the dollar amount indicated after 'Amount: USD'
3. In Col G calculate the fee with this calculation: =(F150*1.35%)+5 with F150 just being a sample row and cell
4. In Col H calculate the balance: =H149+F150-G150-J150 (where H149 is the balance before)
5. Col K gets today's date
6. Col L gets the same value as Col G
7. Then the whole row gets highlighted with a forest green color to show it is different from a debit to the balance as is indicated in Col J

If you need an example MCR page let me know, but I think you have one already. Let me know if you have any questions. Thank you in advance for your help
0
Comment
Question by:JaseSt
  • 20
  • 14
35 Comments
 

Author Comment

by:JaseSt
ID: 36540313
Thank you, teylyn, but I am told by experts that have helped me in the past that posting a question as a related question does NOT alert them that a related question was asked.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 36541130
Noted Teyln comment and it seem I am not notifed when a related question is asked. Can you pls chk status of my account.
gowflow
0
 
LVL 29

Expert Comment

by:gowflow
ID: 36541140
JaseSt
Pls refrain from now to name me in your questions to have it opened for all Expert as I already previously advised. I do not mind working to solve your issues but it has to be on a fair ground open for all.

As regard to this question can you please post sample of emails that are intended for this question save them as .msg and zip them all in 1 file this would enable me better assessment of what to expect.

gowflow
0
 

Author Comment

by:JaseSt
ID: 36543673
Attached. Note that all HMF emails go to the HMF Account page.  Payment-Received-emails.zip
0
 
LVL 29

Expert Comment

by:gowflow
ID: 36548250
JaseSt,
Please confirm or correct my assumptions:

1) I guess the emails reside in the same folder as previous emails upload in earlier question (Import Emails Into Tabs which is located in the Green Combo under: Choose an outlook Folder to Monitor Emails in the Sheet Main)
2) if 1 is correct then when you run your daily Import Emails these (MCR and HMF) are now beeing rejected and not taken in concideration.

If assumption 1 and 2 are correct:
A- Do you want to process these HMF and MCR within the same existing routine (Import Emails Into Tabs) or you want a new buton created that will Import only these ?

B-I recall we had issues with moving the emails to EP Wires and at the end you choose to keep them there for checking. Do you need to revive this option as I feel the problems we previously had was due to the zillion macros you had in this workbook that were all interveening with each others causing reset of global varaibles when a sheet is deleted (Final Report) or a menu is Deleted at start wich was causing these object variable not set !!!

Gowflow
0
 

Author Comment

by:JaseSt
ID: 36548488
1. Yes, in the Inbox, just as the other emails you imported data from
2. that is correct.

A: Yes, same routine
B: While I'd like the emails to be moved to EP Wires once processed I'm leary about doing so because I like to double check everything was imported correctly. That being said, it has worked perfectly so yes, if you want, go ahead and move them to EP Wires once processed. Leave those that aren't in the Inbox.
Thank you.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 36548554
B: While I'd like the emails to be moved to EP Wires once processed I'm leary about doing so because I like to double check everything was imported correctly. That being said, it has worked perfectly so yes, if you want, go ahead and move them to EP Wires once processed. Leave those that aren't in the Inbox.
>>>> Easy !!! Will choose an other folder say 'EP Wire Temp' that they will be moved to and once you check them u manually highlight all and move them to EP Wire !!! As long as they are in EP Wire Temp they have been recorded to the excel but not checked !!!
gowflow
0
 

Author Comment

by:JaseSt
ID: 36548598
No, not necessary to move them to a temp folder. I can check them if I want in the EP Wires folder. Please just move them there. Thanks.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 36548666
Well you seem to have forgotten You choose where you want to move them to !!! by simply select in the combo the folder you want I suggest to create anew folder so the checking is easier instead of going thru other emails that are comming and looking for the ones that need to be checked you will have simply those that need to be checked. Anyway its up to you I will revise this routine and now that I have the same version that you  have I guess will see if we get errors ...

I need your confirmation on the below:
Emails where after From: 'eForex Staff'  > data should goto MCR Eforex Staff sheet
Emails where after From: 'eForex Customers'  > data should goto MCR Eforex Customers sheet
Emails where after From: 'AsiaCom'  > data should goto MCR AsiaCom sheet
Emails where in the From: 'HMF'  > data should goto HMF Account sheet

Pls confirm
gowflow
0
 

Author Comment

by:JaseSt
ID: 36548708
all correct with the understanding the HMF has two accounts: HMF Limited and HMF GTF, but just go off of HMF for they both go to the same tab and they may add other HMF accounts later. Thanks.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 36548875
yes but testing all Emails and if the first 3 is HMF they will endup in 'HMF Account' Is that ok ?
gowflow
0
 

Author Comment

by:JaseSt
ID: 36548897
yes
0
 
LVL 29

Expert Comment

by:gowflow
ID: 36550749
1 quick issue I draw yoiur attention in previous question when we worked on MCR and HMF sheets you did not want to update formulas in Col H where here we are updating H well the file that I have ends with data 5 or 6 lines where H has nothing if now you get a deposit ... H will get the formulas but will not pick up the carried total !!! :) oversight by you I guess !
Pls confirm or maybe I am missing something
gowflow
0
 

Author Comment

by:JaseSt
ID: 36550817
Well, let's just see what happens. Thanks.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 36550913
You insist on making me do things twice !
:(
0
 

Author Comment

by:JaseSt
ID: 36550970
I am? How? Not meaning to.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 36551102
I am telling you when you will get the formulas and see that your file is not carying the subtotal then you will ask me to revise the other Sub
Look at your file and input manually an amount in MCR sheet say 5700 and see what happen in Col H nothing for the next 3 or 4 rows, now immagine you import an email the formulas you gave me
for H is =H149+F150-G150-J150
149 is the previous line in this case it is blank is that ok ???????????
Maybe I am wrong you know the figures just drawing ur attention maybe yes it should not carry from last amount in H and start new ???
gowflow
0
Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

 

Author Comment

by:JaseSt
ID: 36551161
Let's do whatever is easier for you. I can pull-copy the balance down so it's no big deal to leave it blank.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 36553933
Here it is:
This version update not only the individual sheets/tabs when CC start with 5 but also update HMF Account for all HMF emails and MCR realted sheets for all emails with the sheet name. Once Email is found and imported it is moved to the folder choosen in Folder to Transfer Emails in sheet Main. I recommend for testing to create a Temp new folder under the Inbox and select it. The only Emails that will not be Imported with this version are CC starting with 4 that have been dealt with separately.

To implement:
1) Make a New SAVE AS the latest Mastercard workbook you have.
2) Open VBA and doubleclick Module1
3) Select to view 1 sub at a time by clicking on the left icon in the bottom window.
4) At the end of the Declaration Section like after
Global CRow As Long

Paste the code attached by SELECT ALL right click in the code and choose copy and paste after last instruction in the Declaration Section shown above.
5) SAVE the workbook
6) In the left pane of VBA the last sheet should be MAIN doubleclick on it to display its code.
7) switch viewing to left icon in the bottom
8) select from the left dropdown CommandButton2 once displayed
replace
LocateEmailsToTabs
By
LocateEmailsToTabsNew

So that the whole Sub looks like this
=========================
Private Sub CommandButton2_Click()
LocateEmailsToTabsNew
End Sub
=========================
9) SAVE the workbook and exit
10) prepare some emails in your inbox for testing to have all kinds of types. (CC 4 CC 5 MCR and HMF)
11) Create the new folder as suggested (you may decide later that you want to do diffrently its your choice but for now and testing purposes pls do that)
12) REMEMBER that if on any sheet you have previously deleted data by delete and not by ENTIREROW highlight and delete then the new data that will be imported may not come just after the last set of data so sake goood order make sure before you run the test that you go thru the sheets that will be affected by the test and go at the end of the existing data and highlight some 10 to 50 rows and delete them to ensure new data will follow.
13) Run your test !!!

Let me know
gowflow
Function ImportData5New(Body As String, ByVal RDate As Date, Row As Long) As String
On Error GoTo Errhandler25
Dim WS As Worksheet
Dim CC As String
Dim CName As String
Dim Cur As String
Dim Amt As Double
Dim tmp As String
Dim MaxRow As Long

tmpa = Split(Body, Chr(10))

For I = 0 To UBound(tmpa)
    'Find CC and CName
    st = InStr(1, tmpa(I), "From:", vbTextCompare)
    If st <> 0 Then
        If Not IsNumeric(Mid(tmpa(I), st + 6, 1)) Or Mid(tmpa(I), st + 6, 1) <> "5" Then
            If IsNumeric(Mid(tmpa(I), st + 6, 1)) Then
                ImportData5New = Mid(tmpa(I), st + 6)
                Exit Function
            Else
                'Disabled the Exit Function to Trap MCR and HMF Emails
                ImportData5New = Mid(tmpa(I), st + 6)
            End If
        Else
            tmpb = Split(Mid(tmpa(I), st + 6, InStr(st, tmpa(I), Chr(13), vbBinaryCompare)), " ")
            For J = 0 To UBound(tmpb)
                If IsNumeric(tmpb(J)) Then
                    CC = CC & tmpb(J)
                Else
                    Exit For
                End If
            Next J
            
            For k = J To UBound(tmpb)
                CName = CName & tmpb(k) & " "
            Next k
            CName = RTrim(CName)
        End If
    End If
    
    'Find Curency, Amt
    st = InStr(1, tmpa(I), "Amount:", vbTextCompare)
    If st <> 0 Then
        tmpb = Split(Mid(tmpa(I), st + 8, InStr(st, tmpa(I), Chr(13), vbBinaryCompare)), " ")
        If UBound(tmpb) = 1 Then
            Cur = tmpb(0)
            Amt = tmpb(1)
        End If
    End If
Next I

'Save to Excel Tab
MsgBox ("looking for sheet to update")
If ImportData5New = "" Then
    ShtName = FindExcelTab(CC)
Else
    If UCase(Mid(ImportData5New, 1, 3)) = "HMF" Then
        ShtName = "HMF Account"
    Else
        ShtName = "MCR " & ImportData5New
    End If
End If


'Application.ScreenUpdating = False
'Look for the sheet
FoundSheet = False
If ShtName <> "" And InStr(1, ShtName, Chr(13)) <> 0 Then ShtName = Trim(Left(ShtName, InStr(1, ShtName, Chr(13)) - 1))

For Each WS In ThisWorkbook.Worksheets
    If UCase(WS.Name) = UCase(ShtName) Then
        FoundSheet = True
        Exit For
    End If
Next WS

If FoundSheet = False Or ShtName = "" Then
    ImportData5New = "Sheet: " & CName & " Not Found"
    'Exit Function
Else

With Sheets(UCase(ShtName))
    .Activate
    '.UsedRange.Select
    MaxRow = .UsedRange.Rows.count + 1
    
    If ImportData5New = "" Then
        .Cells(MaxRow, "F") = Amt
    Else
        .Cells(MaxRow, "A") = RDate
        .Cells(MaxRow, "F") = Amt
        .Cells(MaxRow, "G").Formula = "=(F" & MaxRow & "*1.35%)"
        .Cells(MaxRow, "H").Formula = "=H" & MaxRow - 1 & "+F" & MaxRow & "-G" & MaxRow & "-J" & MaxRow
        .Cells(MaxRow, "K") = DateValue(Now)
        .Cells(MaxRow, "L").Formula = "=G" & MaxRow
        .Range("A" & MaxRow & ":L" & MaxRow).Interior.ColorIndex = 4
   End If
    If CName = "" Then CName = ShtName
    wsMain.Range("L" & CRow) = "Import Data : <" & CName & " " & RDate
    CRow = CRow + 1
End With
    ImportData5New = ""

'Application.ScreenUpdating = True
'Application.EnableEvents = True

End If


Exit Function

Errhandler25:
MsgBox (Error(err))
wsMain.Range("L" & CRow) = "Import Data - Error: <" & Error(err) & "> Item " & CName & " " & RDate
CRow = CRow + 1

Resume Next

End Function


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
        wsMain.Range("L" & CRow) = "Locate Emails - Imported and 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 Moved: " & EmailMoved & Chr(10) _
    & "Total Emails Not Imported: " & EmailNotMoved & " and kept in '" & objFolderToMonitor & "'" _
    & "Imported Emails were moved to: '" & objFolderToTransfer & "'")
wsMain.Range("L" & CRow) = ("Locate Emails - Total Emails processed from '" & objFolderToMonitor & "' " & TotItems _
    & "Total Emails Imported and Moved: " & EmailMoved _
    & "Total Emails Not Imported: " & EmailNotMoved & " and kept in '" & objFolderToMonitor & "'" _
    & "Imported Emails were moved to: '" & objFolderToTransfer & "'")
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

0
 

Author Comment

by:JaseSt
ID: 36561832
Results:

had two emails come in today for HMF and MCR eforex customers and there were a couple of minor mistakes or misunderstandings:

For the MCR as can be seen, the balance was input and as mentioned, we don't want the balance inserted. Even if we did, the balance was not calculated correctly. Let's just leave the balance column blank. Everything else looked fine.

For the HMF email, we do NOT want a loading fee taken out. Loading fees for the HMF Account page are taken out from the individual load requests on this page as can be seen in the attached image, but NOT in the deposits to this account page.  All we want for the HMF Account page is Col A and H filled in.
However, when I enter a value in Col E - which is the individual load requests for the customer's card - then is when we calculate the loading fee and commission. MCR page HMF page
0
 

Author Comment

by:JaseSt
ID: 36561842
Also, if your intention was to move the emails processed to the "EP Wires" folder, it did not happen.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 36565201
Hi JaseSt,
Sorry but seems either your not concentrated when you post a question or you change your mind quite often.

I have done this deposit EXACTLY as you posted the question. If you need it diffrently pls detail exactly for each type what columns need to be filled in pure and simple. I am amazed on how much you like to waist time. I would expect something like:
For MCR sheets pls fill following columns
Col A = Email date
Col ....

For HMF Sheets
Col .... etc..



And what do you mean "if your intention was to move the emails processed to the "EP Wires" folder, it did not happen. " It is not my intention but the code that is there !! It is tested here and works perfectly fine What is the folder you have set in Transfer emails ? I presume it is EP Wires ARE YOU SURE THEY WERE not transfered ???? I clearly mentioned SAKE OF TESTING CREATE A NEW FOLDER call it something diffrent than EP Wires and it has to be UNDER the inbox if it is too deep it will not be catched. The program catches the next Sub folder to the inbox !!! Pls check it and confirm
gowflow
0
 

Author Comment

by:JaseSt
ID: 36566795
Yes, gowflow, but remember when you asked me:
"I am telling you when you will get the formulas and see that your file is not carying the subtotal then you will ask me to revise the other Sub
Look at your file and input manually an amount in MCR sheet say 5700 and see what happen in Col H nothing for the next 3 or 4 rows, now immagine you import an email the formulas you gave me
for H is =H149+F150-G150-J150
149 is the previous line in this case it is blank is that ok ???????????
Maybe I am wrong you know the figures just drawing ur attention maybe yes it should not carry from last amount in H and start new ???"

and I responded:
"Let's do whatever is easier for you. I can pull-copy the balance down so it's no big deal to leave it blank."

Get back to you in a bit regarding the other question.

0
 

Author Comment

by:JaseSt
ID: 36567502
Moving to folder works great! Forgot that I had to set the path on Main.

Why don't we just leave the balance filled in and let me see how that works for awhile. (I know, I know. I'm going back and forth with this. Sorry. It's hard to know what is the best way to go with this without trying it for awhile.  I think for it to work all we need is a value in the last row of Col H, right?

And, of course it has to deduct values in Col G and I to be accurate.

So, the only thing we need to change is the taking out of loading fees being applied (Col G, etc) from the HMF Account page
0
 
LVL 29

Expert Comment

by:gowflow
ID: 36572035
OK here it is:
This version has addressed the Row number in Col H and wether last formula in H is the row before the last or way up it will locate the last row and the new formula will carry the correct balance. Also Col L Load Fee is not updated for sheet HMF Account.

To implement:
1) Make a new SAVE AS of the last version of your Mastercard file
2) Start the file and goto VBA doubleclick on Module1 and select the left icon in the bottom window to view 1 sub at a time.
3) Display Sub ImportData5New and delete the whole sub
4) Press on SELECT ALL in the below code and right click in it and choose COPY and paste the data after any End Sub in Module1
5) SAVE the workbook and Exit
6) Start the workbook and Try couple of Emails and advise your feedback

gowflow
Function ImportData5New(Body As String, ByVal RDate As Date, Row As Long) As String
On Error GoTo Errhandler25
Dim WS As Worksheet
Dim CC As String
Dim CName As String
Dim Cur As String
Dim Amt As Double
Dim tmp As String
Dim MaxRow As Long, MaxRowH As Long

tmpa = Split(Body, Chr(10))

For I = 0 To UBound(tmpa)
    'Find CC and CName
    st = InStr(1, tmpa(I), "From:", vbTextCompare)
    If st <> 0 Then
        If Not IsNumeric(Mid(tmpa(I), st + 6, 1)) Or Mid(tmpa(I), st + 6, 1) <> "5" Then
            If IsNumeric(Mid(tmpa(I), st + 6, 1)) Then
                ImportData5New = Mid(tmpa(I), st + 6)
                Exit Function
            Else
                'Disabled the Exit Function to Trap MCR and HMF Emails
                ImportData5New = Mid(tmpa(I), st + 6)
            End If
        Else
            tmpb = Split(Mid(tmpa(I), st + 6, InStr(st, tmpa(I), Chr(13), vbBinaryCompare)), " ")
            For J = 0 To UBound(tmpb)
                If IsNumeric(tmpb(J)) Then
                    CC = CC & tmpb(J)
                Else
                    Exit For
                End If
            Next J
            
            For k = J To UBound(tmpb)
                CName = CName & tmpb(k) & " "
            Next k
            CName = RTrim(CName)
        End If
    End If
    
    'Find Curency, Amt
    st = InStr(1, tmpa(I), "Amount:", vbTextCompare)
    If st <> 0 Then
        tmpb = Split(Mid(tmpa(I), st + 8, InStr(st, tmpa(I), Chr(13), vbBinaryCompare)), " ")
        If UBound(tmpb) = 1 Then
            Cur = tmpb(0)
            Amt = tmpb(1)
        End If
    End If
Next I

'Save to Excel Tab
MsgBox ("looking for sheet to update")
If ImportData5New = "" Then
    ShtName = FindExcelTab(CC)
Else
    If UCase(Mid(ImportData5New, 1, 3)) = "HMF" Then
        ShtName = "HMF Account"
    Else
        ShtName = "MCR " & ImportData5New
    End If
End If


'Application.ScreenUpdating = False
'Look for the sheet
FoundSheet = False
If ShtName <> "" And InStr(1, ShtName, Chr(13)) <> 0 Then ShtName = Trim(Left(ShtName, InStr(1, ShtName, Chr(13)) - 1))

For Each WS In ThisWorkbook.Worksheets
    If UCase(WS.Name) = UCase(ShtName) Then
        FoundSheet = True
        Exit For
    End If
Next WS

If FoundSheet = False Or ShtName = "" Then
    ImportData5New = "Sheet: " & CName & " Not Found"
    'Exit Function
Else

With Sheets(UCase(ShtName))
    .Activate
    '.UsedRange.Select
    MaxRow = .UsedRange.Rows.count + 1
    MaxRowH = .Range("H:H").Rows(.Range("H:H").Rows.count).End(xlUp).Row
    
    If ImportData5New = "" Then
        .Cells(MaxRow, "F") = Amt
    Else
        .Cells(MaxRow, "A") = RDate
        .Cells(MaxRow, "F") = Amt
        .Cells(MaxRow, "G").Formula = "=(F" & MaxRow & "*1.35%)"
        .Cells(MaxRow, "H").Formula = "=H" & MaxRowH & "+F" & MaxRow & "-G" & MaxRow & "-J" & MaxRow
        .Cells(MaxRow, "K") = DateValue(Now)
        If UCase(ShtName) <> "HMF ACCOUNT" Then
            .Cells(MaxRow, "L").Formula = "=G" & MaxRow
        End If
        .Range("A" & MaxRow & ":L" & MaxRow).Interior.ColorIndex = 4
   End If
    If CName = "" Then CName = ShtName
    wsMain.Range("L" & CRow) = "Import Data : <" & CName & " " & RDate
    CRow = CRow + 1
End With
    ImportData5New = ""

'Application.ScreenUpdating = True
'Application.EnableEvents = True

End If


Exit Function

Errhandler25:
MsgBox (Error(err))
wsMain.Range("L" & CRow) = "Import Data - Error: <" & Error(err) & "> Item " & CName & " " & RDate
CRow = CRow + 1

Resume Next

End Function

Open in new window

0
 

Author Comment

by:JaseSt
ID: 36583884
For HMF Account:
1 It imported the data correctly, however
2. I do not want Col G (loading fees) calculated or considered. Col G is only considered in the MCR pages. Not HMF Account page.

Correctly imported MCR emails. However, did not move any emails to EP Wires. Says Object Cannot be Found. It worked before.
0
 
LVL 29

Expert Comment

by:gowflow
ID: 36585767
ok here it is.

1) Make a new SAVE AS of the latest version of MasterCard.
2) Goto VBA doubleclick Module1 choose left icon to view 1 sub at a time select Function ImportData5New and delete it.
3) SELECT ALL in the below code window right click choose COPY and paste and any End Sub in Module1
4) SAVE the workbook and Exit.

Now the issue of Object not found if you have your workbook opened and you run any menu option that delete a sheet namely when you run the Final Report then you may get this behaviour as when a Sheet is deleted automatically Excel resets all the Module level variable which are opened and initialized when you start the workbook amoung them the location of the monitor folder and the Transfer folder these values are lost when a sheet is deleted. To avoid this problem when you delete manually a sheet or run a report that will delete a temporary sheet like Final Report once done just save the workbook, close it and re-open it fresh and then start your import of emials.

An other possibility to have this problem is if the code is running and then you get it interrupted like object not found then the next time you run theworkbook it will not have properly closed the workbook hence it would not have the correct setting for the varaibles.

So what you need to do is the following:
1) Open and run the mastercard workbook after you install the new version.
2) Select the monitor folder and the Tansfer folder from the drop down EVEN if they show there You may also be prompt to choose a location for PushTobook files when all folders/files locations choosen then SAVE the workbook and CLOSE it/Exit.
3) Restart the workbook and run it normally to import everything should be fine.

So in conclusion EACH and every time you get an errror in the code and you need to stop the code and close the workbook then you need to do the above 3 steps BEFORE your resume again your work.

Pls let me know
gowflow
Function ImportData5New(Body As String, ByVal RDate As Date, Row As Long) As String
On Error GoTo Errhandler25
Dim WS As Worksheet
Dim CC As String
Dim CName As String
Dim Cur As String
Dim Amt As Double
Dim tmp As String
Dim MaxRow As Long, MaxRowH As Long

tmpa = Split(Body, Chr(10))

For I = 0 To UBound(tmpa)
    'Find CC and CName
    st = InStr(1, tmpa(I), "From:", vbTextCompare)
    If st <> 0 Then
        If Not IsNumeric(Mid(tmpa(I), st + 6, 1)) Or Mid(tmpa(I), st + 6, 1) <> "5" Then
            If IsNumeric(Mid(tmpa(I), st + 6, 1)) Then
                ImportData5New = Mid(tmpa(I), st + 6)
                Exit Function
            Else
                'Disabled the Exit Function to Trap MCR and HMF Emails
                ImportData5New = Mid(tmpa(I), st + 6)
            End If
        Else
            tmpb = Split(Mid(tmpa(I), st + 6, InStr(st, tmpa(I), Chr(13), vbBinaryCompare)), " ")
            For J = 0 To UBound(tmpb)
                If IsNumeric(tmpb(J)) Then
                    CC = CC & tmpb(J)
                Else
                    Exit For
                End If
            Next J
            
            For k = J To UBound(tmpb)
                CName = CName & tmpb(k) & " "
            Next k
            CName = RTrim(CName)
        End If
    End If
    
    'Find Curency, Amt
    st = InStr(1, tmpa(I), "Amount:", vbTextCompare)
    If st <> 0 Then
        tmpb = Split(Mid(tmpa(I), st + 8, InStr(st, tmpa(I), Chr(13), vbBinaryCompare)), " ")
        If UBound(tmpb) = 1 Then
            Cur = tmpb(0)
            Amt = tmpb(1)
        End If
    End If
Next I

'Save to Excel Tab
MsgBox ("looking for sheet to update")
If ImportData5New = "" Then
    ShtName = FindExcelTab(CC)
Else
    If UCase(Mid(ImportData5New, 1, 3)) = "HMF" Then
        ShtName = "HMF Account"
    Else
        ShtName = "MCR " & ImportData5New
    End If
End If


'Application.ScreenUpdating = False
'Look for the sheet
FoundSheet = False
If ShtName <> "" And InStr(1, ShtName, Chr(13)) <> 0 Then ShtName = Trim(Left(ShtName, InStr(1, ShtName, Chr(13)) - 1))

For Each WS In ThisWorkbook.Worksheets
    If UCase(WS.Name) = UCase(ShtName) Then
        FoundSheet = True
        Exit For
    End If
Next WS

If FoundSheet = False Or ShtName = "" Then
    ImportData5New = "Sheet: " & CName & " Not Found"
    'Exit Function
Else

With Sheets(UCase(ShtName))
    .Activate
    '.UsedRange.Select
    MaxRow = .UsedRange.Rows.count + 1
    MaxRowH = .Range("H:H").Rows(.Range("H:H").Rows.count).End(xlUp).Row
    
    If ImportData5New = "" Then
        .Cells(MaxRow, "F") = Amt
    Else
        .Cells(MaxRow, "A") = RDate
        .Cells(MaxRow, "F") = Amt
        If UCase(ShtName) <> "HMF ACCOUNT" Then
            .Cells(MaxRow, "G").Formula = "=(F" & MaxRow & "*1.35%)"
        End If
        .Cells(MaxRow, "H").Formula = "=H" & MaxRowH & "+F" & MaxRow & "-G" & MaxRow & "-J" & MaxRow
        .Cells(MaxRow, "K") = DateValue(Now)
        If UCase(ShtName) <> "HMF ACCOUNT" Then
            .Cells(MaxRow, "L").Formula = "=G" & MaxRow
        End If
        .Range("A" & MaxRow & ":L" & MaxRow).Interior.ColorIndex = 4
   End If
    If CName = "" Then CName = ShtName
    wsMain.Range("L" & CRow) = "Import Data : <" & CName & " " & RDate
    CRow = CRow + 1
End With
    ImportData5New = ""

'Application.ScreenUpdating = True
'Application.EnableEvents = True

End If


Exit Function

Errhandler25:
MsgBox (Error(err))
wsMain.Range("L" & CRow) = "Import Data - Error: <" & Error(err) & "> Item " & CName & " " & RDate
CRow = CRow + 1

Resume Next

End Function

Open in new window

0
 

Author Comment

by:JaseSt
ID: 36586776
Did as you said over and over again, and still getting object cannot be found error. Not sure why it worked in a previous version.

The HMF Account import is now importing properly, EXCEPT when it is calculating balance in Col H it is NOT subtracting debits from Col J. I;ll send screenshot in a couple hours to show you.
0
 

Author Comment

by:JaseSt
ID: 36586953
Needs to subtract the total values in Col J from the last entry in Col H on. Please see attached files for MCR and HMF pages  HMF page HMF page MCR page
0
 

Author Comment

by:JaseSt
ID: 36586975
just take out the moving to EP. it isn't necessary really.
0
 
LVL 29

Accepted Solution

by:
gowflow earned 500 total points
ID: 36589012
OK here it is !!
1) no moving of Emails
2) Col H will carry the formulas from the last spoted row until the current row imported so that the balance stays consistent !!

1) Pls save a new version of mastercard then display module1
2) Delete both sub ImportData5New and LocateEmailsToTabsNew (by selecting the left icon 1 sub at a time)
3) Copy/Paste the below code in module1
4) Save and exit the workbook
5) start it and check it

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
        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


Function ImportData5New(Body As String, ByVal RDate As Date, Row As Long) As String
On Error GoTo Errhandler25
Dim WS As Worksheet
Dim CC As String
Dim CName As String
Dim Cur As String
Dim Amt As Double
Dim tmp As String
Dim MaxRow As Long, MaxRowH As Long

tmpa = Split(Body, Chr(10))

For I = 0 To UBound(tmpa)
    'Find CC and CName
    st = InStr(1, tmpa(I), "From:", vbTextCompare)
    If st <> 0 Then
        If Not IsNumeric(Mid(tmpa(I), st + 6, 1)) Or Mid(tmpa(I), st + 6, 1) <> "5" Then
            If IsNumeric(Mid(tmpa(I), st + 6, 1)) Then
                ImportData5New = Mid(tmpa(I), st + 6)
                Exit Function
            Else
                'Disabled the Exit Function to Trap MCR and HMF Emails
                ImportData5New = Mid(tmpa(I), st + 6)
            End If
        Else
            tmpb = Split(Mid(tmpa(I), st + 6, InStr(st, tmpa(I), Chr(13), vbBinaryCompare)), " ")
            For J = 0 To UBound(tmpb)
                If IsNumeric(tmpb(J)) Then
                    CC = CC & tmpb(J)
                Else
                    Exit For
                End If
            Next J
            
            For k = J To UBound(tmpb)
                CName = CName & tmpb(k) & " "
            Next k
            CName = RTrim(CName)
        End If
    End If
    
    'Find Curency, Amt
    st = InStr(1, tmpa(I), "Amount:", vbTextCompare)
    If st <> 0 Then
        tmpb = Split(Mid(tmpa(I), st + 8, InStr(st, tmpa(I), Chr(13), vbBinaryCompare)), " ")
        If UBound(tmpb) = 1 Then
            Cur = tmpb(0)
            Amt = tmpb(1)
        End If
    End If
Next I

'Save to Excel Tab
MsgBox ("looking for sheet to update")
If ImportData5New = "" Then
    ShtName = FindExcelTab(CC)
Else
    If UCase(Mid(ImportData5New, 1, 3)) = "HMF" Then
        ShtName = "HMF Account"
    Else
        ShtName = "MCR " & ImportData5New
    End If
End If


'Application.ScreenUpdating = False
'Look for the sheet
FoundSheet = False
If ShtName <> "" And InStr(1, ShtName, Chr(13)) <> 0 Then ShtName = Trim(Left(ShtName, InStr(1, ShtName, Chr(13)) - 1))

For Each WS In ThisWorkbook.Worksheets
    If UCase(WS.Name) = UCase(ShtName) Then
        FoundSheet = True
        Exit For
    End If
Next WS

If FoundSheet = False Or ShtName = "" Then
    ImportData5New = "Sheet: " & CName & " Not Found"
    'Exit Function
Else

With Sheets(UCase(ShtName))
    .Activate
    '.UsedRange.Select
    MaxRow = .UsedRange.Rows.count + 1
    MaxRowH = .Range("H:H").Rows(.Range("H:H").Rows.count).End(xlUp).Row
    
    If ImportData5New = "" Then
        .Cells(MaxRow, "F") = Amt
    Else
        .Cells(MaxRow, "A") = RDate
        .Cells(MaxRow, "F") = Amt
        If UCase(ShtName) <> "HMF ACCOUNT" Then
            .Cells(MaxRow, "G").Formula = "=(F" & MaxRow & "*1.35%)"
        End If
        .Range("H" & MaxRowH & ":H" & MaxRow).FillDown
        .Range("H" & MaxRowH + 1 & ":H" & MaxRow).Interior.ColorIndex = 0
        '.Cells(MaxRow, "H").Formula = "=H" & MaxRowH & "+F" & MaxRow & "-G" & MaxRow & "-J" & MaxRow
        .Cells(MaxRow, "K") = DateValue(Now)
        If UCase(ShtName) <> "HMF ACCOUNT" Then
            .Cells(MaxRow, "L").Formula = "=G" & MaxRow
        End If
        .Range("A" & MaxRow & ":L" & MaxRow).Interior.ColorIndex = 4
   End If
    If CName = "" Then CName = ShtName
    wsMain.Range("L" & CRow) = "Import Data : <" & CName & " " & RDate
    CRow = CRow + 1
End With
    ImportData5New = ""

'Application.ScreenUpdating = True
'Application.EnableEvents = True

End If


Exit Function

Errhandler25:
MsgBox (Error(err))
wsMain.Range("L" & CRow) = "Import Data - Error: <" & Error(err) & "> Item " & CName & " " & RDate
CRow = CRow + 1

Resume Next

End Function

Open in new window

0
 

Author Closing Comment

by:JaseSt
ID: 36593941
Got it, gowflow. Thanks once again. Great work!

I have a few other questions involving another workbook, the Visa spreadsheet. Are you willing to do that? You already have a copy of it I believe.

If you're willing to go for it, I will give you the link to the quesetion but won't put it just for gowlfow as the admin recommended. Let me know.

Thank you!
0
 

Author Comment

by:JaseSt
ID: 36593945
I will put in the link and question here for your fixing the MasterCard spreadsheet for me a few weeks ago next, however.
0
 

Author Comment

by:JaseSt
ID: 36594012
0

Featured Post

Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

Join & Write a Comment

Outlook Free & Paid Tools
Is your Office 365 signature not working the way you want it to? Are signature updates taking up too much of your time? Let's run through the most common problems that an IT administrator can encounter when dealing with Office 365 email signatures.
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

757 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

18 Experts available now in Live!

Get 1:1 Help Now