Solved

Excel 2007 - From Outlook to spreadsheet

Posted on 2010-11-11
35
418 Views
Last Modified: 2012-05-10
I get a bunch of emaiils in this form:

Transaction #       00000002E7-xxx
Client:       SML.
Account #       USD-100-458475
Value date:       09/11/2010
Posted date:       09/11/2010
Amount:       7,951.60
Currency:       US Dollars
Credit / Debit:       Credit

Is there an automated way of putting that data into a spreadsheet without having to always copy and paste? The column on the left would be the column headings and the values on the right of the above example would comprise one record (one row - so it transposes) and as each email comes in, some might have more than one of these but the left hand column would always be the same text.

So, as each email comes in, it would fill up this spreadsheet one row at a time. The workbook would be named DirectDepositTransfers.

0
Comment
Question by:Morya1
  • 18
  • 14
  • 3
35 Comments
 
LVL 38

Expert Comment

by:puppydogbuddy
Comment Utility
This link has step by step code to export Outlook emails to excel using VBA.  However, it will have to be modified to include parsing of the body of the email into the field components you want.  These modifications can be made later after you get the basic process working.

         http://blogs.techrepublic.com.com/msoffice/?p=744
0
 

Author Comment

by:Morya1
Comment Utility
Thanks, and it looks promising, but I don't want to spend the time working with it if it doesn't work for Office 2007. It states on the website the code was written for Office 2003.

Even then, what I am really looking for is the solution where I wouldn't have to put a lot of time to customize because, right now, I just don't have the time.
0
 
LVL 38

Expert Comment

by:puppydogbuddy
Comment Utility
There is no reason that it should not work in 2007...the code is written using VBA, which has not changed.  therefore the code should work as is for your application, except that the parsing code  for the email body needs to be added.  If you are not willing to spend the time needed for your own application, then I  don't think anybody is going to be able to help you.
0
 
LVL 38

Expert Comment

by:puppydogbuddy
Comment Utility
if you are interested, see this link for a vba parsing routine on the email body that be adapted to your specifics, and integrated with the code I gave you previously.
        http://www.experts-exchange.com/Software/Office_Productivity/Groupware/Outlook/Q_24908662.html
0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
Here is a code to read mail from the Inbox (or can be coded to read for a specific folder if need be... the concerned mails can be routed to a specific folder using Outlook filters).

Each of the mail would be scanned for a "SubjectHint" (set this variable in the code)

Once run, the macro would scan all mails in that folder and if meets the criteria, parse the body of the mail and extract the required details. It would then populate the excel file accordingly. Note that 2 new columns have been added... Mail ID and Mail Received Date. Mail ID is stored so that no mail is extracted twice (using the unique ID of the mails).
Option Explicit
Const sSubjectHint As String = "Deposit"

Public Sub FetchMails()
Dim olApp As Object, sIn As String
Set olApp = CreateObject("Outlook.Application")

    Dim olNs 'As Namespace
    Dim Fldr 'As MAPIFolder
    Dim olMail As Variant
    Dim i As Integer

    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(6)
    i = 1

    For Each olMail In Fldr.Items
        If InStr(olMail.body, "Transaction #") > 0 Or _
            InStr(olMail.Subject, sSubjectHint) > 0 Then
            
            If Application.WorksheetFunction.CountIf(Application.Range("I:I"), olMail.entryid) = 0 Then
                sIn = olMail.body        
                ActiveSheet.Cells(i + 1, 1).Value = ReturnTagValue(sIn, "Transaction #")
                ActiveSheet.Cells(i + 1, 2).Value = ReturnTagValue(sIn, "Client:")
                ActiveSheet.Cells(i + 1, 3).Value = ReturnTagValue(sIn, "Account #")
                ActiveSheet.Cells(i + 1, 4).Value = ReturnTagValue(sIn, "Value date:")
                ActiveSheet.Cells(i + 1, 5).Value = ReturnTagValue(sIn, "Posted date:")
                ActiveSheet.Cells(i + 1, 6).Value = ReturnTagValue(sIn, "Amount:")
                ActiveSheet.Cells(i + 1, 7).Value = ReturnTagValue(sIn, "Currency:")
                ActiveSheet.Cells(i + 1, 8).Value = ReturnTagValue(sIn, "Credit / Debit:")
                ActiveSheet.Cells(i + 1, 9).Value = olMail.entryid
                ActiveSheet.Cells(i + 1, 10).Value = Format(olMail.ReceivedTime, "dd-mmm-yy hh:mm AM/PM")
                i = i + 1
            End If
        End If
    Next olMail

    Set Fldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing

End Sub

Public Function ReturnTagValue(sIn As String, sTag As String)
Dim nTemp As Long
nTemp = InStr(1, sIn, sTag, vbTextCompare)
If nTemp = 0 Then Exit Function
ReturnTagValue = Trim(Mid(sIn, nTemp + Len(sTag) + 1))
nTemp = InStr(1, ReturnTagValue, vbCrLf, vbTextCompare)
If nTemp = 0 Then Exit Function
ReturnTagValue = Trim(Mid(ReturnTagValue, 1, nTemp - 1))
End Function

Open in new window

Read-From-Outlook.xlsm
0
 

Author Comment

by:Morya1
Comment Utility
Looks promissing gbanik, I'll give it a try soon, but how does the code get initiated? What makes it do its thing?
0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
Check the attached Excel file... run the macro "FetchMails" and step thru the code (F8) to understand more.

Note: If you run the macro directly without a breakpoint u might not get any results in return. Thats b'cos, first you have to configure the sSubjectHint variable to set the hint in the subject line. Example if the subject contains "Transaction - Direct Deposit to Account XXX" you could use "Direct Deposit" as the Subject Hint. The Subject hint will allow you to separate your chosen mails from the rest in the Inbox.

Also please read through my earlier post very carefully first.
0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
To answer how it could be initiated...

Add the subroutine FetchMails in the Workbook_Open event. That way when the workbook is opened, automatically the mails in your mailbox would be scanned. Also, since each record maintains the Mail ID, it parses only NEW mails and skips the already parsed ones!
Private Sub Workbook_Open()
FetchMails
End Sub

Open in new window

0
 

Author Comment

by:Morya1
Comment Utility
Looks good gbanik. How do I tell it to look in my folder named "EP Direct Deposits"?
0
 

Author Comment

by:Morya1
Comment Utility
Just so you can see my folder scheme, see attached. And also know my Outlook account in IMAPed to our company gmail account if that matters. folders
0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
Change line
Set Fldr = olNs.GetDefaultFolder(6)
to
Set Fldr = olNs.Folders("support@offshore.xxxxxx").Folders("EP Direct Deposits")
0
 

Author Comment

by:Morya1
Comment Utility
Getting an error, bganik. Here's the code and attached is the error.

 error
Option Explicit
Const sSubjectHint As String = "Deposit"

Private Sub Workbook_Open()
FetchMails
End Sub

Public Sub FetchMails()
Dim olApp As Object, sIn As String
Set olApp = CreateObject("Outlook.Application")

    Dim olNs 'As Namespace
    Dim Fldr 'As MAPIFolder
    Dim olMail As Variant
    Dim i As Integer

    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.Folders("support@offshore.xxxxxx").Folders("EP Direct Deposits")
    i = 1

    For Each olMail In Fldr.Items
        If InStr(olMail.body, "Transaction #") > 0 Or _
            InStr(olMail.Subject, sSubjectHint) > 0 Then
            
            If Application.WorksheetFunction.CountIf(Application.Range("I:I"), olMail.entryid) = 0 Then
                sIn = olMail.body
                
                'sIn = "Transaction #       00000002E7-xxx" & vbCrLf & _
                        "Client:       SML." & vbCrLf & _
                        "Account #       USD-100-458475" & vbCrLf & _
                        "Value date:       09/11/2010" & vbCrLf & _
                        "Posted date:       09/11/2010" & vbCrLf & _
                        "Amount:       7,951.60" & vbCrLf & _
                        "Currency:       US Dollars" & vbCrLf & _
                        "Credit / Debit:       Credit"
        
                ActiveSheet.Cells(i + 1, 1).Value = ReturnTagValue(sIn, "Transaction #")
                ActiveSheet.Cells(i + 1, 2).Value = ReturnTagValue(sIn, "Client:")
                ActiveSheet.Cells(i + 1, 3).Value = ReturnTagValue(sIn, "Account #")
                ActiveSheet.Cells(i + 1, 4).Value = ReturnTagValue(sIn, "Value date:")
                ActiveSheet.Cells(i + 1, 5).Value = ReturnTagValue(sIn, "Posted date:")
                ActiveSheet.Cells(i + 1, 6).Value = ReturnTagValue(sIn, "Amount:")
                ActiveSheet.Cells(i + 1, 7).Value = ReturnTagValue(sIn, "Currency:")
                ActiveSheet.Cells(i + 1, 8).Value = ReturnTagValue(sIn, "Credit / Debit:")
                ActiveSheet.Cells(i + 1, 9).Value = olMail.entryid
                ActiveSheet.Cells(i + 1, 10).Value = Format(olMail.ReceivedTime, "dd-mmm-yy hh:mm AM/PM")
                i = i + 1
            End If
        End If
    Next olMail

    Set Fldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing

End Sub

Public Function ReturnTagValue(sIn As String, sTag As String)
Dim nTemp As Long
nTemp = InStr(1, sIn, sTag, vbTextCompare)
If nTemp = 0 Then Exit Function
ReturnTagValue = Trim(Mid(sIn, nTemp + Len(sTag) + 1))
nTemp = InStr(1, ReturnTagValue, vbCrLf, vbTextCompare)
If nTemp = 0 Then Exit Function
ReturnTagValue = Trim(Mid(ReturnTagValue, 1, nTemp - 1))
End Function

Open in new window

0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
Sorry, I should have been more explicit...

Replace this
support@offshore.xxxxxx
by the actual folder name

You had blurred the image.
0
 

Author Comment

by:Morya1
Comment Utility
Beautiful! Just great!

However it didn't initiate when I opened the spreadsheet. Not a big deal really. And the Mail ID didn't have numbers. See attached.

And, I will be adding Credit Card Number and Reference Number as labels and their values to the incoming email. How do I add those to the code and import tojavascript:void(0); the spreadsheet? And I may rather have it initiate automatically with each coming email that has a specific word in the subject.

Ooops! Big problem. I tested with another email coming in and it erased the previous entry. See attached. no number remove previous entry
0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
First, I deliberately did not code it to fire as soon as you open the workbook. Thats because, you need to perfect it first. To initiate it on Workbook open, see my comment above... ID:34125091.

Now about the Mail ID, the mail ID is too long and hence I had set the "Shrink to Fit" property of the cell. To see the value select the cell and see the formula bar.

In order to initiate the process on every incoming mail, modify the line
        If InStr(olMail.body, "Transaction #") > 0 Or _
            InStr(olMail.Subject, sSubjectHint) > 0 Then
to
        If InStr(olMail.body, "Transaction #") > 0 Then

Finally, about the entries getting deleted.... indeed that was an error on my part. Change the following line
    i = 1
to
    i = Application.Range("A1").CurrentRegion.Rows.Count + 1

Now it should be fine!
0
 

Author Comment

by:Morya1
Comment Utility
Thank you, gbanik. Please look at the attached. Started out good. Had two emails in the designated folder and didn't quite bring in the second one. 2nd one not filled out
0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
Can u check whether the 2nd mail passes the if criterra that the body contains "Transaction #"? If so, please post the final code of yours. This is a very minor code glitch that is stopping u now.
0
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

 

Author Comment

by:Morya1
Comment Utility
I don't know. Here's the body of the 2nd email: email
Option Explicit
Const sSubjectHint As String = "Deposit"

Private Sub Workbook_Open()
FetchMails
End Sub

Public Sub FetchMails()
Dim olApp As Object, sIn As String
Set olApp = CreateObject("Outlook.Application")

    Dim olNs 'As Namespace
    Dim Fldr 'As MAPIFolder
    Dim olMail As Variant
    Dim i As Integer

    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.Folders("support@offshore-protection.com").Folders("EP Direct Deposits")
    i = Application.Range("A1").CurrentRegion.Rows.Count + 1

    For Each olMail In Fldr.Items
        If InStr(olMail.body, "Transaction #") > 0 Or _
            InStr(olMail.Subject, sSubjectHint) > 0 Then
            
            If Application.WorksheetFunction.CountIf(Application.Range("I:I"), olMail.entryid) = 0 Then
                sIn = olMail.body
                
                'sIn = "Transaction #       00000002E7-xxx" & vbCrLf & _
                        "Client:       SML." & vbCrLf & _
                        "Account #       USD-100-458475" & vbCrLf & _
                        "Value date:       09/11/2010" & vbCrLf & _
                        "Posted date:       09/11/2010" & vbCrLf & _
                        "Amount:       7,951.60" & vbCrLf & _
                        "Currency:       US Dollars" & vbCrLf & _
                        "Credit / Debit:       Credit"
        
                ActiveSheet.Cells(i + 1, 1).Value = ReturnTagValue(sIn, "Transaction #")
                ActiveSheet.Cells(i + 1, 2).Value = ReturnTagValue(sIn, "Client:")
                ActiveSheet.Cells(i + 1, 3).Value = ReturnTagValue(sIn, "Account #")
                ActiveSheet.Cells(i + 1, 4).Value = ReturnTagValue(sIn, "Value date:")
                ActiveSheet.Cells(i + 1, 5).Value = ReturnTagValue(sIn, "Posted date:")
                ActiveSheet.Cells(i + 1, 6).Value = ReturnTagValue(sIn, "Amount:")
                ActiveSheet.Cells(i + 1, 7).Value = ReturnTagValue(sIn, "Currency:")
                ActiveSheet.Cells(i + 1, 8).Value = ReturnTagValue(sIn, "Credit / Debit:")
                ActiveSheet.Cells(i + 1, 9).Value = olMail.entryid
                ActiveSheet.Cells(i + 1, 10).Value = Format(olMail.ReceivedTime, "dd-mmm-yy hh:mm AM/PM")
                i = i + 1
            End If
        End If
    Next olMail

    Set Fldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing

End Sub

Public Function ReturnTagValue(sIn As String, sTag As String)
Dim nTemp As Long
nTemp = InStr(1, sIn, sTag, vbTextCompare)
If nTemp = 0 Then Exit Function
ReturnTagValue = Trim(Mid(sIn, nTemp + Len(sTag) + 1))
nTemp = InStr(1, ReturnTagValue, vbCrLf, vbTextCompare)
If nTemp = 0 Then Exit Function
ReturnTagValue = Trim(Mid(ReturnTagValue, 1, nTemp - 1))
End Function

Open in new window

0
 

Author Comment

by:Morya1
Comment Utility
Also, I still have that previous question:

I will be adding Credit Card Number and Reference Number as labels and their values will be in the the incoming email. How do I add those to the code and import them to the spreadsheet?
0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
Adding new fields like Credit Card Number and Reference Number should be easy enough. Just keep adding tag parsing statements...

ActiveSheet.Cells(i + 1, 8).Value = ReturnTagValue(sIn, "Credit / Debit:")
ActiveSheet.Cells(i + 1, 9).Value = ReturnTagValue(sIn, "Credit Card Number:")
ActiveSheet.Cells(i + 1, 10).Value = ReturnTagValue(sIn, "Reference Number:")
ActiveSheet.Cells(i + 1, 11).Value = olMail.entryid
ActiveSheet.Cells(i + 1, 12).Value = Format(olMail.ReceivedTime, "dd-mmm-yy hh:mm AM/PM")

Regarding the 2nd mail error, check the subject of the 2nd mail... it says "EP 2 - test" rather than something like "XXX Deposit XXX". Thats what the code is checking for. Please MODIFY the sSubjectHint to suit your conditions... or eliminate it altogether if need be.
0
 
LVL 13

Accepted Solution

by:
gbanik earned 500 total points
Comment Utility
For every new field you add, the Mail Entry ID column gets shifted. Hence remember to change it accordingly
....
If Application.WorksheetFunction.CountIf(Application.Range("I:I"), olMail.entryid) = 0 Then
....
from "I:I" to whatever you have.
0
 

Author Closing Comment

by:Morya1
Comment Utility
Thank you, gbank. This will save me tons of time. I really appreciate your help. A++
0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
Thanks Morya1. I appreciate your compliments and your A++. But for some reason, the rating came only as 5.8
I would again appreciate if you would oblige with a rating correction if you please.
0
 

Author Comment

by:Morya1
Comment Utility
how do I do that, gbanik?

And not sure what I do to the code:
If Application.WorksheetFunction.CountIf(Application.Range("I:I"), olMail.entryid) = 0 Then

Below you can see I've added a Description column. Did I do it right and what do I change the I:I to?

If Application.WorksheetFunction.CountIf(Application.Range("I:I"), olMail.entryid) = 0 Then
                sIn = olMail.body
               
                'sIn = "Transaction #       00000002E7-xxx" & vbCrLf & _
                        "Client:       SML." & vbCrLf & _
                        "Account #       USD-100-458475" & vbCrLf & _
                        "Value date:       09/11/2010" & vbCrLf & _
                        "Posted date:       09/11/2010" & vbCrLf & _
                        "Amount:       7,951.60" & vbCrLf & _
                        "Currency:       US Dollars" & vbCrLf & _
                        "Credit / Debit:       Credit" & _
                        "Description:   Description"
       
                ActiveSheet.Cells(i + 1, 1).Value = ReturnTagValue(sIn, "Transaction #")
                ActiveSheet.Cells(i + 1, 2).Value = ReturnTagValue(sIn, "Client:")
                ActiveSheet.Cells(i + 1, 3).Value = ReturnTagValue(sIn, "Account #")
                ActiveSheet.Cells(i + 1, 4).Value = ReturnTagValue(sIn, "Value date:")
                ActiveSheet.Cells(i + 1, 5).Value = ReturnTagValue(sIn, "Posted date:")
                ActiveSheet.Cells(i + 1, 6).Value = ReturnTagValue(sIn, "Amount:")
                ActiveSheet.Cells(i + 1, 7).Value = ReturnTagValue(sIn, "Currency:")
                ActiveSheet.Cells(i + 1, 8).Value = ReturnTagValue(sIn, "Credit / Debit:")
                ActiveSheet.Cells(i + 1, 9).Value = ReturnTagValue(sIn, "Description:")
                ActiveSheet.Cells(i + 1, 10).Value = olMail.entryid
                ActiveSheet.Cells(i + 1, 11).Value = Format(olMail.ReceivedTime, "dd-mmm-yy hh:mm AM/PM")
                i = i + 1
            End If
0
 

Author Comment

by:Morya1
Comment Utility
And, I can't say it is working. I get the first email that has only one record in it, but the second email has five records to import and it comes out like the attached. I will attach you code I updated as you directed. fetch mail screen shot
And here's two records out of the email that didn't import:

Transaction #       00000002F9-772
Client:       Sovereign Management & Legal S.A.
Account #       EUR-100-458209-3
Value date:       12/11/2010
Posted date:       12/11/2010
Amount:       100.00
Currency:       Euro
Credit / Debit:       Credit
Description:       Incoming deposit Card#4381xxxxx01 - Pela, Satu
Transaction #       00000002FF-784
Client:       Sovereign Management & Legal S.A.
Account #       EUR-100-458209-3
Value date:       15/11/2010
Posted date:       15/11/2010
Amount:       1,000.00
Currency:       Euro
Credit / Debit:       Credit
Description:       Incoming deposit Card#438101xxxxx04 - Bria, David

'Option Explicit

'Const sSubjectHint As String = "Deposit"



Private Sub Workbook_Open()

FetchMails

End Sub



Public Sub FetchMails()

Dim olApp As Object, sIn As String

Set olApp = CreateObject("Outlook.Application")



    Dim olNs 'As Namespace

    Dim Fldr 'As MAPIFolder

    Dim olMail As Variant

    Dim i As Integer



    Set olNs = olApp.GetNamespace("MAPI")

    Set Fldr = olNs.Folders("support@offshore-protection.com").Folders("EP Direct Deposits")

    i = Application.Range("A1").CurrentRegion.Rows.Count + 1



    For Each olMail In Fldr.Items

        If InStr(olMail.body, "Transaction #") > 0 Or _

            InStr(olMail.Subject, sSubjectHint) > 0 Then

            

            If Application.WorksheetFunction.CountIf(Application.Range("J:J"), olMail.entryid) = 0 Then

                sIn = olMail.body

                

                'sIn = "Transaction #       00000002E7-xxx" & vbCrLf & _

                        "Client:       SML." & vbCrLf & _

                        "Account #       USD-100-458475" & vbCrLf & _

                        "Value date:       09/11/2010" & vbCrLf & _

                        "Posted date:       09/11/2010" & vbCrLf & _

                        "Amount:       7,951.60" & vbCrLf & _

                        "Currency:       US Dollars" & vbCrLf & _

                        "Credit / Debit:       Credit" & _

                        "Description:   Description"

        

                ActiveSheet.Cells(i + 1, 1).Value = ReturnTagValue(sIn, "Transaction #")

                ActiveSheet.Cells(i + 1, 2).Value = ReturnTagValue(sIn, "Client:")

                ActiveSheet.Cells(i + 1, 3).Value = ReturnTagValue(sIn, "Account #")

                ActiveSheet.Cells(i + 1, 4).Value = ReturnTagValue(sIn, "Value date:")

                ActiveSheet.Cells(i + 1, 5).Value = ReturnTagValue(sIn, "Posted date:")

                ActiveSheet.Cells(i + 1, 6).Value = ReturnTagValue(sIn, "Amount:")

                ActiveSheet.Cells(i + 1, 7).Value = ReturnTagValue(sIn, "Currency:")

                ActiveSheet.Cells(i + 1, 8).Value = ReturnTagValue(sIn, "Credit / Debit:")

                ActiveSheet.Cells(i + 1, 9).Value = ReturnTagValue(sIn, "Description:")

                ActiveSheet.Cells(i + 1, 10).Value = olMail.entryid

                ActiveSheet.Cells(i + 1, 11).Value = Format(olMail.ReceivedTime, "dd-mmm-yy hh:mm AM/PM")

                i = i + 1

            End If

        End If

    Next olMail



    Set Fldr = Nothing

    Set olNs = Nothing

    Set olApp = Nothing



End Sub



Public Function ReturnTagValue(sIn As String, sTag As String)

Dim nTemp As Long

nTemp = InStr(1, sIn, sTag, vbTextCompare)

If nTemp = 0 Then Exit Function

ReturnTagValue = Trim(Mid(sIn, nTemp + Len(sTag) + 1))

nTemp = InStr(1, ReturnTagValue, vbCrLf, vbTextCompare)

If nTemp = 0 Then Exit Function

ReturnTagValue = Trim(Mid(ReturnTagValue, 1, nTemp - 1))

End Function

Open in new window

0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
I:I gets changed to whatever the new mail ID Column is...
I am guessing your mail ID column now is J, as you have added a new parameter "Description". Hence use J:J

By the way, to change the rating u will have to just post "Change rating" as a new question to the General Area. Someone will attend to it.
http://www.experts-exchange.com/Community_Support/General/newQuestionWizard.jsp
0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
The code expects only one block of info per mail (check your example). I do not see you mention this earlier that a single mail could have multiple blocks of info??

To manage the multiple blocks of info within a mail, the code needs to first split into blocks, and then run the parsing logic one block at a time (loop).

Another piece of advice Morya1, expect the Experts to provide you directions... be prepared to connect the final dots.
"And, I can't say it is working....." may be too harsh.
0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
Let me work on the code for you.... give me few moments.....
0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
Option Explicit
Const sSubjectHint As String = "Deposit"

Public Sub FetchMails()
Dim olApp As Object, sInVar As Variant, sIn As String, jCtr As Integer
Set olApp = CreateObject("Outlook.Application")

    Dim olNs 'As Namespace
    Dim Fldr 'As MAPIFolder
    Dim olMail As Variant
    Dim i As Integer

    Set olNs = olApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(6)
    i = Application.Range("A1").CurrentRegion.Rows.Count + 1

    For Each olMail In Fldr.Items
        If InStr(olMail.body, "Transaction #") > 0 Or _
            InStr(olMail.Subject, sSubjectHint) > 0 Then
            
            If Application.WorksheetFunction.CountIf(Application.Range("I:I"), olMail.entryid) = 0 Then
                
                sInVar = Split(olMail.body, "Transaction #")
                
                For jCtr = LBound(sInVar) + 1 To UBound(sInVar)
                
                    sIn = "Transaction # " & sInVar(jCtr)
            
                    ActiveSheet.Cells(i + 1, 1).Value = ReturnTagValue(sIn, "Transaction #")
                    ActiveSheet.Cells(i + 1, 2).Value = ReturnTagValue(sIn, "Client:")
                    ActiveSheet.Cells(i + 1, 3).Value = ReturnTagValue(sIn, "Account #")
                    ActiveSheet.Cells(i + 1, 4).Value = ReturnTagValue(sIn, "Value date:")
                    ActiveSheet.Cells(i + 1, 5).Value = ReturnTagValue(sIn, "Posted date:")
                    ActiveSheet.Cells(i + 1, 6).Value = ReturnTagValue(sIn, "Amount:")
                    ActiveSheet.Cells(i + 1, 7).Value = ReturnTagValue(sIn, "Currency:")
                    ActiveSheet.Cells(i + 1, 8).Value = ReturnTagValue(sIn, "Credit / Debit:")
                    ActiveSheet.Cells(i + 1, 9).Value = olMail.entryid
                    ActiveSheet.Cells(i + 1, 10).Value = Format(olMail.ReceivedTime, "dd-mmm-yy hh:mm AM/PM")
                    i = i + 1
                    
                Next
                
            End If
        End If
    Next olMail

    Set Fldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing

End Sub

Public Function ReturnTagValue(sIn As String, sTag As String)
Dim nTemp As Long
nTemp = InStr(1, sIn, sTag, vbTextCompare)
If nTemp = 0 Then Exit Function
ReturnTagValue = Trim(Mid(sIn, nTemp + Len(sTag) + 1))
nTemp = InStr(1, ReturnTagValue, vbCrLf, vbTextCompare)
If nTemp = 0 Then Exit Function
ReturnTagValue = Trim(Mid(ReturnTagValue, 1, nTemp - 1))
End Function

Open in new window

0
 

Author Comment

by:Morya1
Comment Utility
My apologies. Guess I was in a hurry to respond as I was needing it to work this am. What you've done has been great.

On multiple blocks: "The column on the left would be the column headings and the values on the right of the above example would comprise one record (one row - so it transposes) and as each email comes in, some might have more than one of these but the left hand column would always be the same text. "

Guess that wasn't explained too well,

Thank you for the extra effort.
0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
Sorry ... I used the code that I had at my end... u may have to edit back the changes u made like ...

Set Fldr = olNs.Folders("support@offshore-protection.com").Folders("EP Direct Deposits")

and the new column

Description.

0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
Also may I ask you to add a zone "Outlook" to the question?
0
 

Author Comment

by:Morya1
Comment Utility
Wow!!! I can't tell you how great that is!!!

I do have another thing that needs to be done with it but I will post another related question.
But to give you a heads up, if you would like to work on it, it seems that the Description column VALUE is coming in like this:

Description:       Incoming deposit Card#438101xxxxx104 - Brita, David

So, Col B has the "Incoming deposit Card#" as a consistent label. Since it is consistent, but in Col B,  can we break that string up and put "Incoming deposit Card#" as one column header and Cardholder Name in another column, effectively breaking up the string where there is the - before the name and putting the card number in one column and the name in another?

Let me know if you want to work on that and I'll post it repeating the above info.

Thank you again. Great work!

0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
yeah ... lemme do it for you...
Post your latest code that u r working on (so that u dont have to reformat again) and gimme a few minutes....

meanwhile please add the Outlook Zone to this question.
0
 
LVL 13

Expert Comment

by:gbanik
Comment Utility
this is very much within this question :)
please post your code
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Convert between Excel file formats (.XLS, .XLSX, .XLSM) with/without macro option David Miller (dlmille) Intro Over this past Fall, I've had the opportunity to see several similar requests and have developed a couple related solutions associate…
This tutorial explains how to create a series of drop-down lists that are dependent upon prior selections to guide (“force”) the user to make the correct selection and reduce data errors within Microsoft Excel. Excel 2010 was used for this tutorial;…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.

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

6 Experts available now in Live!

Get 1:1 Help Now