Pulling info from Excel based on certain criteria 1

[jdhamot]

Hello Everyone,

My company sends out a monthly email to our customers, we usually get around 1500 emails returned with a delivery failure notification error. Someone is currently opening all these emails and copying the address from the body of the email and deleting it from our database. I found software that will grab these emails and compile all of them into an excel spreadsheet. So now I have the entire message from all of the delivery failure notification error emails. The good thing about this is that I now have the email address of who we originally sent to and got the error back from. This email address is in the body of the email and looks like this To: xxx@domain.com. My question is how can I search through this excel spreadsheet and return all of these email addresses (all of the emails are put into column A of the spreadsheet with each line of the email placed in a new row)? Here is my though process right now:

Create a macro and in the VBA editor write a function that will loop through each row of the entire spreadsheet and grab everything in the cell that follows "To: " and return that value into column B.

Unfortunately I am not sure how this code should look or if something like this is even possible. I am thinking a do while loop and then an if then statement stepping through each active cell. I would really appreciate any help or thoughts on this matter.

Thank you very much for your time and insight!!!
Josh

 

[SkipVought]

Hi,

It might not be that simple, since you have multiple lines per message.

There are a possible 3 different cases
[tt]
now is the time [highlight]To: skip@mail.com [/highlight]and more

now is the time and more [highlight]To: skip2@mail.com[/highlight]

now is the time and more [highlight]To:
Skip3@Mail.com [/highlight]and yet more
[/tt]
Be back later.


Skip,
[sub]
[red]Be Advised![/red] For those this winter, caught in Arctic-like calamity, be consoled...
Many are cold, but few are frozen![/sub]

 

[SkipVought]

Sub test()
    For Each r In Range([a1], [a1].End(xlDown))
        sAddr = ""
        p1 = InStr(r.Value, "To:")
        If p1 > 0 Then
            If p1 + 4 > Len(r.Value) Then
                'address on next line
                p2 = InStr(r.Offset(1).Value, " ")
                sAddr = Left(r.Offset(1).Value, p2 - 1)
            Else
                p2 = InStr(p1 + 4, r.Value, " ")
                If p2 > 0 Then
                    sAddr = Mid(r.Value, p1 + 4, p2 - (p1 + 4))
                Else
                    sAddr = Right(r.Value, Len(r.Value) - (p1 + 4) + 1)
                End If
            End If
        End If
        r.Offset(0, 1).Value = sAddr
    Next
End Sub

Skip,
[sub]
[red]Be Advised![/red] For those this winter, caught in Arctic-like calamity, be consoled...
Many are cold, but few are frozen![/sub]

 

[jdhamot]

Hi Skip,

Thank you very much for your quick responce. I understand exactly what you are saying about how it may not be that easy, when I first looked at the project I though oh no problem. Then after taking a more in depth look I realized there were a lot more variables that were going to be come into play. Thank you for the code and I'm going to work with that now and will update you with my progress. I really appreciate the time and help.

Josh

 

[jdhamot]

Hi Skip,

Sorry, but reporting preparation for inventory takes precedence over all other projects. I finally got a chance to take a look at the code you provided for me. It seems that when I run it I am not getting any output. I was hoping you could explain the code a little bit for me so that I can get a better idea of where I'm going wrong. I understand what you are doing overall, but some of the code is confusing me. For instance, you are setting the range (r) and seeing if "To:" is in that cell range. I am getting lost when you get into the embedding If...Then statements (I assume that you are trying to take into account the instances of words coming before or after the email address). Like I said I pretty much copy and pasted the code into a VBAProject for my worksheet and I am not getting anything for an output. I know you are very busy and I appreciate the halp so far. If I have been unclear with anything please tell me and I'd be happy to clear something up. It has been quite sometime since I have been this involved with using VB in Excel.

Thank you!
Josh

 

[SkipVought]

Sub test()[b]
'this assumes that your data is in column A beginning in row 1 AND that it resides in contiguous rows[/b]
    For Each r In Range([b][a1], [a1].End(xlDown)[/b])
        sAddr = ""
        p1 = InStr(r.Value, "To:")

'There are a possible 3 different cases
'Case 1
'now is the time To: skip@mail.com and more
'Case 2
'now is the time and more To: skip2@mail.com
'Case 3
'now is the time and more To:
'Skip3@Mail.com and yet more

        If p1 > 0 Then   
            If p1 + 4 > Len(r.Value) Then    [b]'Case 1[/b]
                'address on next line
                p2 = InStr(r.Offset(1).Value, " ")
                sAddr = Left(r.Offset(1).Value, p2 - 1)
            Else                             [b]'Case 2[/b]
                p2 = InStr(p1 + 4, r.Value, " ")
                If p2 > 0 Then
                    sAddr = Mid(r.Value, p1 + 4, p2 - (p1 + 4))
                Else                         [b]'Case 3[/b]
                    sAddr = Right(r.Value, Len(r.Value) - (p1 + 4) + 1)
                End If
            End If
        End If
        r.Offset(0, 1).Value = sAddr
    Next
End Sub

Skip,
[sub]
[red]Be Advised![/red] Dyslexic poets...
write inverse! [/sub]

 

[SkipVought]

1) It might be helpful to post a sample of the data that you described.

2) In the code that I posted above...

p1 is the starting character position of the string To: in the cell value of the row being evaluated

p2 is the ending character position of the space following the eMail address (if there is one)

Skip,
[sub]
[red]Be Advised![/red] Dyslexic poets...
write inverse! [/sub]

 

[jdhamot]

Hi Skip,

Here is a small example of the data that we are looking at. This example is from a Mail Delivery Error Message:

Organization: Company Name
X-Mailer: YAMS 3.4
To: "customer@prodigy.net"<customer@prodigy.net>
Subject: Company’s Monthly E-mail
Sender: johndoe@company.com
Mime-Version: 1.0
Content-Type: text/html; charset="iso-8859-1"
Date: Tue, 31 Jan 2006 16:48:59 -0500
Message-ID: <39D5E0046F20@server.company.com>

Now before and after this clip of data there is a great deal of other stuff, such as the entire email, the To: .... is also found in the body of the returned email, etc. But, from the data I have looked at it seems like all of the returned emails have these few lines in them somewhere. I probably should have given you this sample data first and I apologize if we were approaching this the wrong way. And yes all of this data is in column A1 going down through the excel spreadsheet. I am hoping to have the email address moved from column A to column B.

Thank you again for your time and help!

Josh

 

[SkipVought]

Is this data in ONE cell or more?

Skip,
[sub]
[red]Be Advised![/red] Dyslexic poets...
write inverse! [/sub]

 

[SkipVought]

I just ran the code (copy 'n' paste from this thread to my VBA) and it ran with the expected result using your example.
[tt]
Data Column Results column
To: "customer@prodigy.net"<customer@prodigy.net> "customer@prodigy.net"<customer@prodigy.net>

[/tt]

Skip,
[sub]
[red]Be Advised![/red] Dyslexic poets...
write inverse! [/sub]

 

[jdhamot]

I did the same thing you did, pasted that sample data into another spreadsheet and ran the code with the correct results. So I was trying to figure out why there would be a difference and I found that if I copied that sample data multiple times on the spreadsheet with empty cells between each data the code would not return anything after it hit an empty cell. If I deleted the empty cells then I did get the correct data repeatedly. Long story short I have a lot of empty rows in my excel spreadsheet and I think this is why the code is not working properly. Does this line of code have anything to do with this (For Each r In Range([a1], [a1].End(xlDown)))? It seems like it might stop once it finds a blank cell thinking it is at the end of the data.

Once again thanks for all your help, I really appreciate it and am learning a lot along the way!

Josh

 

[Gavona]

You are correct about the reason for the code stopping. To understand what it is doing:
Hold [Shift]
Select cell a1
Press [End] then [Down]

That is the data that it is operating on.

A quick fix:
Change the code to
For each r in Selection

Make sure you have all the range selected before trying to run the code again.
(I am not sure if the code will fall over when it tries to evaluate a blank cell)

PS Don't forget to give Skip a star!


Gavin

 

[jdhamot]

Gavin,

Oh I definitely won't forget to give Skip a star he's helped me out tremendously. Thanks for the suggestions, I'm going to give that a shot.

Josh