Link to home
Start Free TrialLog in
Avatar of Morya1
Morya1

asked on

Excel 2007 - From Outlook to spreadsheet

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.

Avatar of puppydogbuddy
puppydogbuddy

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
Avatar of Morya1

ASKER

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.
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.
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.
        https://www.experts-exchange.com/questions/24908662/Parse-Text-From-Outlook-Body-Using-VBA.html
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
Avatar of Morya1

ASKER

Looks promissing gbanik, I'll give it a try soon, but how does the code get initiated? What makes it do its thing?
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.
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

Avatar of Morya1

ASKER

Looks good gbanik. How do I tell it to look in my folder named "EP Direct Deposits"?
Avatar of Morya1

ASKER

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. User generated image
Change line
Set Fldr = olNs.GetDefaultFolder(6)
to
Set Fldr = olNs.Folders("support@offshore.xxxxxx").Folders("EP Direct Deposits")
Avatar of Morya1

ASKER

Getting an error, bganik. Here's the code and attached is the error.

 User generated image
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

Sorry, I should have been more explicit...

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

You had blurred the image.
Avatar of Morya1

ASKER

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. User generated image User generated image
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!
Avatar of Morya1

ASKER

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. User generated image
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.
Avatar of Morya1

ASKER

I don't know. Here's the body of the 2nd email: User generated image
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

Avatar of Morya1

ASKER

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?
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.
ASKER CERTIFIED SOLUTION
Avatar of gbanik
gbanik
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of Morya1

ASKER

Thank you, gbank. This will save me tons of time. I really appreciate your help. A++
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.
Avatar of Morya1

ASKER

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
Avatar of Morya1

ASKER

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. User generated image
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

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.
https://www.experts-exchange.com/Community_Support/General/newQuestionWizard.jsp
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.
Let me work on the code for you.... give me few moments.....
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

Avatar of Morya1

ASKER

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

Also may I ask you to add a zone "Outlook" to the question?
Avatar of Morya1

ASKER

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!

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.
this is very much within this question :)
please post your code