PeggieGreg

asked on

# Email Auto Extract and Reply

Hi Experts,

this is a question that I think I wont find an answer for, or if I do find an answer it is going to be beyond my 'knowhow'.

we receive leads from 3rd party companies via email for people who might be interested in purchasing one off our products. please see attachment to view the leads.

what I want to achieve is to somehow be able to automatically send an email to the email address in each off these leads. so therefore what I am looking is for the following:

step 1 - receive lead email in normal format

step 2 - identify email from email body / maybe the name as well?

step 3 - send a generic email to this email / try to include the name as well?

I have got some open source code which allows me to extract the email from the email body into an excel sheet.

Environment information:

Windows 7 64bit

Office 2003

Outlook 2003

SBS2011 running exchange

this is a question that I think I wont find an answer for, or if I do find an answer it is going to be beyond my 'knowhow'.

we receive leads from 3rd party companies via email for people who might be interested in purchasing one off our products. please see attachment to view the leads.

what I want to achieve is to somehow be able to automatically send an email to the email address in each off these leads. so therefore what I am looking is for the following:

step 1 - receive lead email in normal format

step 2 - identify email from email body / maybe the name as well?

step 3 - send a generic email to this email / try to include the name as well?

I have got some open source code which allows me to extract the email from the email body into an excel sheet.

Environment information:

Windows 7 64bit

Office 2003

Outlook 2003

SBS2011 running exchange

ASKER

Hi Fanpages,

I was only suppose to post 1 picture but accidently done the 2. The pictures are the leads we receive, not open source coding. this is how the emails arrive in our MS-outlook.

the enquiry form does not get received from our website, we receive these from 3rd parties. we have about 2 or 3 which all use a generic format.

I am looking for a solution that works, if I have to pay then I will look into the costing. if I have to do it in a different programme then I can as well. I only mentioned the MS stuff because that's what we are receiving the emails in.

the open source code I already have is:

Dim eMails(), noms() As String

Dim EmailFromBody As Boolean

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Sub GetEmail()

Set rep = Outlook.Application.ActiveExplorer.CurrentFolder

reponse = MsgBox("Do you want to extract emails from messages ?", vbYesNoCancel)

If reponse = vbCancel Then

Exit Sub

ElseIf reponse = vbYes Then

EmailFromBody = True

Else

EmailFromBody = False

End If

ReDim Preserve eMails(1), noms(1)

eMails(1) = ""

noms(1) = ""

GetEmailFromFolder rep

If eMails(1) <> "" Then

NomFichier = GetTempDir() & "/emails.xls"

Close #1

Open NomFichier For Output As #1

For i = 1 To UBound(eMails)

Print #1, AfficheEmail(noms(i), eMails(i))

Next

Close #1

MsgBox UBound(eMails) & " emails found in " & rep, vbInformation, "Done"

OpenExcel (NomFichier)

Else

MsgBox "No email found " & rep, vbInformation, "Done"

End If

End Sub

Function AfficheEmail(Nom, email)

email = Replace(email, "'", "")

If Nom = "" Or Nom = "body" Then

Nom = email

End If

AfficheEmail = email + vbTab + Nom + vcrlf

End Function

Sub GetEmailFromFolder(MyFolder)

Dim myItemRec, MyItem As Object

Dim myMailItem As Outlook.MailItem

For Each MyItem In MyFolder.Folders

GetEmailFromFolder MyItem

Next

rep = Replace(MyFolder.FolderPath, "\", vbTab)

For Each MyItem In MyFolder.Items

If TypeName(MyItem) = "MailItem" Then

For Each myItemRec In MyItem.Recipients

addMail myItemRec.Name & vbTab & "dest" & rep, myItemRec.Address

Next

addMail MyItem.SenderName & vbTab & "exp" & rep, MyItem.SenderEmailAddress

If EmailFromBody Then findMail MyItem.body, rep

End If

Next

End Sub

Sub addMail(Nom, email)

email = TrimEmail(email)

Nom = Trim(Nom)

If email <> "" And InStr(email, "@") > 0 And InStr(email, ".") > 0 Then

Find = UBound(Filter(eMails, email, True, vbTextCompare))

If eMails(1) = "" Then

eMails(1) = email

noms(1) = Nom

ElseIf Find = -1 Then

ReDim Preserve eMails(UBound(eMails) + 1)

ReDim Preserve noms(UBound(noms) + 1)

eMails(UBound(eMails)) = email

noms(UBound(noms)) = Nom

Else

If Len(Nom) > Len(noms(Find)) And InStr(Nom, "@") = 0 Then

noms(Find) = Nom

End If

End If

End If

End Sub

Sub findMail(body, rep)

at = InStr(body, "@")

Do While at > 1

D = at - 1

Do While carOk(Mid(body, D, 1))

D = D - 1

If D = 0 Then

Exit Do

End If

Loop

F = at + 1

Do While carOk(Mid(body, F, 1))

F = F + 1

If F = Len(body) Then

Exit Do

End If

Loop

If D < at - 3 And F > at + 4 Then

addMail vbTab & "corps" & rep, Mid(body, D + 1, F - D - 1)

End If

at = InStr(at + 1, body, "@")

Loop

End Sub

Function carOk(c)

If c = "." Or c = "-" Or c = "_" Or (c >= "0" And c <= "9") Or (c >= "A" And c <= "Z") Or (c >= "a" And c <= "z") Then

carOk = True

Else

carOk = False

End If

End Function

Function carOkDebut(c)

If c = "-" Or c = "_" Or (c >= "0" And c <= "9") Or (c >= "a" And c <= "z") Then

carOkDebut = True

Else

carOkDebut = False

End If

End Function

Function carOkFin(c)

If (c >= "a" And c <= "z") Then

carOkFin = True

Else

carOkFin = False

End If

End Function

Function TrimEmail(email_ini)

email = Trim(LCase(email_ini))

D = Len(email)

For i = 1 To D

If Not carOkDebut(Left(email, 1)) Then

email = Mid(email, 2, Len(email) - 1)

Else

Exit For

End If

Next i

D = Len(email)

For i = 1 To D

If Not carOkFin(Right(email, 1)) Then

email = Mid(email, 1, Len(email) - 1)

Else

Exit For

End If

Next i

TrimEmail = email

End Function

Sub OpenExcel(FileName)

Set xls = CreateObject("Excel.Application")

xls.Workbooks.Open FileName

xls.Visible = True

Exit Sub

End Sub

Function GetTempDir() As String

Dim buffer As String * 256

Dim Length As Long

Length = GetTempPath(Len(buffer), buffer)

GetTempDir = Left(buffer, Length)

End Function

the problem is I don't know what solution im looking for, i need an expert to tell me!

and we out website does not operate in anyway that a customer can obtain a quotation. the website is purely for information.

hope I answered everything you mentioned

I was only suppose to post 1 picture but accidently done the 2. The pictures are the leads we receive, not open source coding. this is how the emails arrive in our MS-outlook.

the enquiry form does not get received from our website, we receive these from 3rd parties. we have about 2 or 3 which all use a generic format.

I am looking for a solution that works, if I have to pay then I will look into the costing. if I have to do it in a different programme then I can as well. I only mentioned the MS stuff because that's what we are receiving the emails in.

the open source code I already have is:

Dim eMails(), noms() As String

Dim EmailFromBody As Boolean

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Sub GetEmail()

Set rep = Outlook.Application.Active

reponse = MsgBox("Do you want to extract emails from messages ?", vbYesNoCancel)

If reponse = vbCancel Then

Exit Sub

ElseIf reponse = vbYes Then

EmailFromBody = True

Else

EmailFromBody = False

End If

ReDim Preserve eMails(1), noms(1)

eMails(1) = ""

noms(1) = ""

GetEmailFromFolder rep

If eMails(1) <> "" Then

NomFichier = GetTempDir() & "/emails.xls"

Close #1

Open NomFichier For Output As #1

For i = 1 To UBound(eMails)

Print #1, AfficheEmail(noms(i), eMails(i))

Next

Close #1

MsgBox UBound(eMails) & " emails found in " & rep, vbInformation, "Done"

OpenExcel (NomFichier)

Else

MsgBox "No email found " & rep, vbInformation, "Done"

End If

End Sub

Function AfficheEmail(Nom, email)

email = Replace(email, "'", "")

If Nom = "" Or Nom = "body" Then

Nom = email

End If

AfficheEmail = email + vbTab + Nom + vcrlf

End Function

Sub GetEmailFromFolder(MyFolde

Dim myItemRec, MyItem As Object

Dim myMailItem As Outlook.MailItem

For Each MyItem In MyFolder.Folders

GetEmailFromFolder MyItem

Next

rep = Replace(MyFolder.FolderPat

For Each MyItem In MyFolder.Items

If TypeName(MyItem) = "MailItem" Then

For Each myItemRec In MyItem.Recipients

addMail myItemRec.Name & vbTab & "dest" & rep, myItemRec.Address

Next

addMail MyItem.SenderName & vbTab & "exp" & rep, MyItem.SenderEmailAddress

If EmailFromBody Then findMail MyItem.body, rep

End If

Next

End Sub

Sub addMail(Nom, email)

email = TrimEmail(email)

Nom = Trim(Nom)

If email <> "" And InStr(email, "@") > 0 And InStr(email, ".") > 0 Then

Find = UBound(Filter(eMails, email, True, vbTextCompare))

If eMails(1) = "" Then

eMails(1) = email

noms(1) = Nom

ElseIf Find = -1 Then

ReDim Preserve eMails(UBound(eMails) + 1)

ReDim Preserve noms(UBound(noms) + 1)

eMails(UBound(eMails)) = email

noms(UBound(noms)) = Nom

Else

If Len(Nom) > Len(noms(Find)) And InStr(Nom, "@") = 0 Then

noms(Find) = Nom

End If

End If

End If

End Sub

Sub findMail(body, rep)

at = InStr(body, "@")

Do While at > 1

D = at - 1

Do While carOk(Mid(body, D, 1))

D = D - 1

If D = 0 Then

Exit Do

End If

Loop

F = at + 1

Do While carOk(Mid(body, F, 1))

F = F + 1

If F = Len(body) Then

Exit Do

End If

Loop

If D < at - 3 And F > at + 4 Then

addMail vbTab & "corps" & rep, Mid(body, D + 1, F - D - 1)

End If

at = InStr(at + 1, body, "@")

Loop

End Sub

Function carOk(c)

If c = "." Or c = "-" Or c = "_" Or (c >= "0" And c <= "9") Or (c >= "A" And c <= "Z") Or (c >= "a" And c <= "z") Then

carOk = True

Else

carOk = False

End If

End Function

Function carOkDebut(c)

If c = "-" Or c = "_" Or (c >= "0" And c <= "9") Or (c >= "a" And c <= "z") Then

carOkDebut = True

Else

carOkDebut = False

End If

End Function

Function carOkFin(c)

If (c >= "a" And c <= "z") Then

carOkFin = True

Else

carOkFin = False

End If

End Function

Function TrimEmail(email_ini)

email = Trim(LCase(email_ini))

D = Len(email)

For i = 1 To D

If Not carOkDebut(Left(email, 1)) Then

email = Mid(email, 2, Len(email) - 1)

Else

Exit For

End If

Next i

D = Len(email)

For i = 1 To D

If Not carOkFin(Right(email, 1)) Then

email = Mid(email, 1, Len(email) - 1)

Else

Exit For

End If

Next i

TrimEmail = email

End Function

Sub OpenExcel(FileName)

Set xls = CreateObject("Excel.Applic

xls.Workbooks.Open FileName

xls.Visible = True

Exit Sub

End Sub

Function GetTempDir() As String

Dim buffer As String * 256

Dim Length As Long

Length = GetTempPath(Len(buffer), buffer)

GetTempDir = Left(buffer, Length)

End Function

the problem is I don't know what solution im looking for, i need an expert to tell me!

and we out website does not operate in anyway that a customer can obtain a quotation. the website is purely for information.

hope I answered everything you mentioned

ASKER

Also just to add, I think that mail merge might be able to do what I want? but i will still need assistance with this

ASKER CERTIFIED SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

ASKER

I will come back to this in the future, I will not be trying to peruse this any further. thanks for your help so far.

Are the two images you have posted from the "open source code" output, or is this how the e-mails arrive in your MS-Outlook "inbox"?

Having an image of an e-mail is probably not going to be much use to anybody wishing to help.

Is it possible you can use, what I presume is, your web site to submit an enquiry (form) with known (but test/sample) data, so you can then wait for the arrival of this & save the entire e-mail (headers, & body) to a Text file for posting in a subsequent attachment?

Also, are you looking for a solution based within your MS-Outlook environment in an automated manner, or something like the MS-Excel workbook code you presently have access to that can be run on the e-mails within your MS-Outlook account (I presume).

Some idea of what kind of solution you would like is going to be helpful as is, I would guess, details of the open source code you already have available.

Finally, does a third party operate your web site for submitting the enquiries?

Have you spoken with them to seek their guidance? It may be easier to produce the required e-mail back to the interested party at the point of submission. You then would not be involved (directly) with the extraction of details as you summarised above. All this would be automatic before you see the e-mails arrive.