Creating Contacts From Incoming Emails (USD $20.00)

jonny · Feb 10th 2016

Required to scanning thousands of email in Outlook inbox and the subfolders. From each email to retrieve the sender details and add into the contact list (only out of corporate senders).
For those senders who have auto signature , need to extract the data as phone# , company , e.t.s into relevant contact fields. The purpose is to have a contact list with full contacts data.
Once all this done , the script should run in background for all new incoming emails.
I want to get a VB code as well.

Thanks

**S O** · Feb 10th 2016

Re: Creating Contacts From Incoming Emails (USD $2.00)

Couple of things:

Quote from jonny

I want to get a VB code as well.

So you want all that to happen without using VBA, and then you want a VBA script in addition to that?

also - you want all that for $2 ?

jonny · Feb 10th 2016

Re: Creating Contacts From Incoming Emails (USD $2.00)

I want to have a code that doing the mentioned task. All that for 20$ (2$ is 10% of the budget).

jonny · May 22nd 2016

Re: Creating Contacts From Incoming Emails (USD $2.00)

Guys - please offer your price for this project.
I want to have a code that scans incoming e-mails (and retroactively all inbox) and creates a contact from the auto signature.
See the screenshot as an example:

[ATTACH=CONFIG]69200[/ATTACH]

trunten · May 23rd 2016

Re: Creating Contacts From Incoming Emails (USD $20.00)

Is there any common pattern to the auto signature?

jonny · May 23rd 2016

Re: Creating Contacts From Incoming Emails (USD $20.00)

Unfortunately there no common pattern, the purpose is to have some code based on reg.exp. Something similar to algorithm of business card scanning applications.

**S O** · May 23rd 2016

Re: Creating Contacts From Incoming Emails (USD $20.00)

Quote

there no common pattern

regular expressions are entirely based on pattern matching - so if there is no regular pattern that certainly isn't going to help.

jonny · May 23rd 2016

Re: Creating Contacts From Incoming Emails (USD $20.00)

The only issue could be is to extract sender title, but I don't see a problem to extract the below :
1. Company name - could be extracted from the sender email.
2. Sender name first and last - could be extracted from the sender email.
3. Sender email - could be extracted from the sender email.
4. Phone number - could be extracted from the email body.
5. Company website - could be extracted from the email body.

**S O** · May 23rd 2016

Re: Creating Contacts From Incoming Emails (USD $20.00)

You might not see a problem, but there absolutely are some:

Quote

1. Company name - could be extracted from the sender email.

example: [email protected]

is the company name:

a) "the macro man"
b) "the mac roman"
c) "them acro man"
d) "themac roman"

Quote

2. Sender name first and last - could be extracted from the sender email.

example: [email protected]

some companies use mailboxes, not individual mail addresses.

Quote

4. Phone number - could be extracted from the email body.

example:

Tel: +44(0)7894 561 231
Tel: +44(0)1298 546 211
Fax: +44(0)1298 456 201

which one do you use? or even more of a problem in the email body is says something like:

"...
... you can get hold of him on 07894561230 ...
..."

and then more numbers in the signature. Again, which one do you use? How does the code know this?

trunten · May 23rd 2016

Re: Creating Contacts From Incoming Emails (USD $20.00)

What he said!

Anyway, probably not going to able to do this for you. Especially not in VBA using outlook because of the security rules. However, here's a quick attempt I made:

Code

Option Explicit


Sub outlookShenanigans()
    Dim outlookApp, olNs, Fldr, olMessage, myMail, e, earliestDate
    Dim name, url, phone, title, email, company, i
    
    'change me
    ''''''''''
    earliestDate = "01/05/2016"
    ''''''''''
    ''''''''''
    
    Set outlookApp = CreateObject("Outlook.Application")
    Set olNs = outlookApp.GetNamespace("MAPI")
    Set Fldr = olNs.GetDefaultFolder(6)
    Set myMail = Fldr.Items.Restrict("[Received] >= '" & Format(earliestDate & " 0:00am", "ddddd h:nn AMPM") & "'")
    Set re = CreateObject("VbScript.RegExp")
    re.IgnoreCase = True
    re.MultiLine = True
    ActiveSheet.Cells.ClearContents
    ActiveSheet.Range("A1:E1").Value = Split("Receieved,Name,Email,Company,Website,Phone", ",")
    i = 1
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    For Each olMessage In myMail
        If olMessage.Class = 43 Then
            i = i + 1
            'phone
            re.Pattern = "^(\([0-9]{3}\) |[0-9]{3}-)[0-9]{3}-[0-9]{4}$"
            re.IgnoreCase = True
            re.MultiLine = True
            If re.Test(olMessage.Body) Then
                phone = re.Execute(olMessage.Body)(0)
            Else
                phone = ""
            End If
            'url
            re.Pattern = "^(https?:\/\/)?([\da-z\.-]+)\.([a-z\.]{2,6})([\/\w \.-]*)*\/?$"
            If re.Test(olMessage.Body) Then
                url = re.Execute(olMessage.Body)(0)
            Else
                url = ""
            End If
            'the rest
            name = olMessage.SenderName
            email = IIf(olMessage.SenderEmailType = "EX", name, olMessage.SenderEmailAddress)
            company = IIf(InStr(1, email, "@") > 0, Mid(email, InStr(1, email, "@") + 1), olMessage.Companies)
            ActiveSheet.Cells(i, 1).Resize(, 5).Value = Array(CStr(olMessage.ReceivedTime), name, email, company, url, phone)
        End If
        'If i > 100 Then
        '    Debug.Print "Had to stop!"
        '    Exit For
        'End If
    Next
    Set outlookApp = Nothing
    Set olNs = Nothing
    Set Fldr = Nothing
    Set myMail = Nothing
    Set re = Nothing
    Set olMessage = Nothing
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

Display More

It kinda works, but also kinda doesn't. give it a shot to see what I mean. Maybe somebody else can build on it, but I'm out. Sorry.

trunten

Creating Contacts From Incoming Emails (USD $20.00)

Participate now!

Share