Create an outlook contact from Excel via VB

mnmhenry

Board Regular
Joined
Mar 28, 2002
Messages
167
I'm sure we all type this stuff TWICE. Enter details into excel and a month later when the job goes ahead, same data goes into Outlook Contacts.

I have the typical A1 "name", A2 "address", A3 "phone" list in excel and I would like to run some VB and put it into an Outlook contact.

I can find lots of code but nothing for outlook 2007 & Excel 2007

This is what I hove fount and is similar to what I am wanting but 2007 seems to be different with its reference to Outlook.



Sub Create_Outlook_Contact() ' Macro by Eliott Robson

Dim outlookApp As Outlook.Application
Dim outlookNameSpace As Outlook.Namespace
Dim outlookFolder As Outlook.Folders
Dim outookContact As Outlook.ContactItem
Dim ContactName As String
Dim ContactAddress As String
Dim ContactHomePhoneNumber As String
Dim ContactEmail As String

Set outlookApp = New Outlook.Application
Set outlookNameSpace = outlookApp.GetNamespace("MAPI")
Set outookContact = outlookApp.CreateItem(olContactItem)

ContactName = Cells(1, "B").Value
ContactAddress = Cells(2, "B").Value
ContactHomePhoneNumber = Cells(3, "B").Value
ContactEmail = Cells(4, "B").Value

With outookContact
.FullName = ContactName
.HomeAddress = ContactAddress
.HomeTelephoneNumber = ContactHomePhoneNumber
.Email1Address = ContactEmail
.JobTitle = ContactEmail
End With

outookContact.Save
MsgBox "Contact exported."

Many thanks.
 

Some videos you may like

Excel Facts

Why does 9 mean SUM in SUBTOTAL?
It is because Sum is the 9th alphabetically in Average, Count, CountA, Max, Min, Product, StDev.S, StDev.P, Sum, VAR.S, VAR.P.

s.ridd

Board Regular
Joined
Nov 23, 2012
Messages
178
Your code below works fine. You need to set a reference to the Microsoft Outlook 12.0 Object Library via Tools>References within the VBE.

Code:
Sub Create_Outlook_Contact() ' Macro by Eliott Robson

Dim outlookApp As Outlook.Application
Dim outlookNameSpace As Outlook.Namespace
Dim outlookFolder As Outlook.Folders
Dim outookContact As Outlook.ContactItem
Dim ContactName As String
Dim ContactAddress As String
Dim ContactHomePhoneNumber As String
Dim ContactEmail As String


Set outlookApp = New Outlook.Application
Set outlookNameSpace = outlookApp.GetNamespace("MAPI")
Set outookContact = outlookApp.CreateItem(olContactItem)


ContactName = Cells(1, "B").Value
ContactAddress = Cells(2, "B").Value
ContactHomePhoneNumber = Cells(3, "B").Value
ContactEmail = Cells(4, "B").Value


With outookContact
    .FullName = ContactName
    .HomeAddress = ContactAddress
    .HomeTelephoneNumber = ContactHomePhoneNumber
    .Email1Address = ContactEmail
    .JobTitle = ContactEmail
    .Save
End With


MsgBox "Contact exported."


End Sub

Otherwise you could try something like this

Code:
Sub Create_Outlook_Contact() ' Macro by Eliott Robson

Dim outlookApp As Object
Dim outlookNameSpace As Object
Dim outlookFolder As Object
Dim outookContact As Object
Dim ContactName As String
Dim ContactAddress As String
Dim ContactHomePhoneNumber As String
Dim ContactEmail As String


Set outlookApp = CreateObject("Outlook.Application")
Set outlookNameSpace = outlookApp.GetNamespace("MAPI")
outlookNameSpace.GetDefaultFolder(10).Display 'Contact won't appear without this line of code
Set outookContact = outlookApp.CreateItem(2)


ContactName = Cells(1, "B").Value
ContactAddress = Cells(2, "B").Value
ContactHomePhoneNumber = Cells(3, "B").Value
ContactEmail = Cells(4, "B").Value


With outookContact
    .FullName = ContactName
    .HomeAddress = ContactAddress
    .HomeTelephoneNumber = ContactHomePhoneNumber
    .Email1Address = ContactEmail
    .JobTitle = ContactEmail
    .Save
End With


outlookApp.Quit 'close Outlook again


MsgBox "Contact exported."


End Sub

Simon
 

mnmhenry

Board Regular
Joined
Mar 28, 2002
Messages
167
Thanks Simon that's a great help. The only other item I am fighting with is I'm wanting to export the active row where as the code below is selecting individual cells.

ContactName = Cells(8, "A").Value
ContactAddress = Cells(8, "B").Value
ContactHomePhoneNumber = Cells(8, "C").Value
ContactEmail = Cells(8, "D").Value
 
Last edited:

mnmhenry

Board Regular
Joined
Mar 28, 2002
Messages
167
I was able to work out what I needed.

ContactName = Cells(Application.ActiveCell.Row, 1).Value
ContactAddress = Cells(Application.ActiveCell.Row, 2).Value
ContactHomePhoneNumber = Cells(Application.ActiveCell.Row, 3).Value
ContactEmail = Cells(Application.ActiveCell.Row, 4).Value

Thanks for your help.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,493
Messages
5,601,998
Members
414,490
Latest member
Rip181

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top