GMail contacts import from Outlook

[Guest chucky.egg]

Anyone here tried importing contacts from Outlook into GMail?

Work won't let me sync my calendar and contacts to Google (buggers! I've just discovered the excellent Google integration in Android too!) so I'm trying to manually import Contacts as they won't change often.

The import works, but only the name and email address fields are properly assigned - everything else just gets lumped into the GMail contact Notes field.

I've tried stripping out extra data (just importing name, email, phone, mobile) and it seems to do it regardless.

Any tips gratefully received!

[Guest chucky.egg]

I've tried every which way I can think of, and I think I've finally sussed it (works in FF anyway).

Put both the header field names, and the values in double quotes

Use the Outlook field names

No spaces around the commas

No blank line at the end of the file

"First Name","Last Name","Business Phone","Mobile Phone","Other Phone","E-mail Address"

"Fred","Blogs","01622 123456","07890 123456","0845 1234567","[email protected]"

For info, in case anyone else is trying this, the Outlook 2007 Field Names are:

"Title","First Name","Middle Name","Last Name","Suffix","Company","Department","Job Title","Business Street","Business Street 2","Business Street 3","Business City","Business State","Business Postal Code","Business Country/Region","Home Street","Home Street 2","Home Street 3","Home City","Home State","Home Postal Code","Home Country/Region","Other Street","Other Street 2","Other Street 3","Other City","Other State","Other Postal Code","Other Country/Region","Assistant's Phone","Business Fax","Business Phone","Business Phone 2","Callback","Car Phone","Company Main Phone","Home Fax","Home Phone","Home Phone 2","ISDN","Mobile Phone","Other Fax","Other Phone","Pager","Primary Phone","Radio Phone","TTY/TDD Phone","Telex","Account","Anniversary","Assistant's Name","Billing Information","Birthday","Business Address PO Box","Categories","Children","Directory Server","E-mail Address","E-mail Type","E-mail Display Name","E-mail 2 Address","E-mail 2 Type","E-mail 2 Display Name","E-mail 3 Address","E-mail 3 Type","E-mail 3 Display Name","Gender","Government ID Number","Hobby","Home Address PO Box","Initials","Internet Free Busy","Keywords","Language","Location","Manager's Name","Mileage","Notes","Office Location","Organizational ID Number","Other Address PO Box","Priority","Private","Profession","Referred By","Sensitivity","Spouse","User 1","User 2","User 3","User 4","Web Page"

[edit]

When I get a chance I'll finalise the VBA code to export core info, in case anyone wants it

Edited September 16, 2009 by chucky.egg

[Guest chucky.egg]

Here's my code:

You can just copy and paste it into VBA in Outlook

Notes:

Use default Contacts and Calendar folders

Creates file: c:\Outlook\Contacts.csv

Creates file: c:\Outlook\Contacts.csv

Generates and email (does not send) with attachments

Sub ProcessExports()


	Dim varResult As Variant


	ExportCalendar

	ExportContacts

	SendEmail


End Sub


Function Quote(MyText)


	MyText = Replace(MyText, ",", ". ")

	MyText = Replace(MyText, vbCrLf, ".")

	MyText = Replace(MyText, vbCr, ".")

	MyText = Replace(MyText, vbLf, ".")

	MyText = Replace(MyText, vbNewLine, ".")

	Quote = Chr(34) & MyText & Chr(34)


End Function


Function QuoteComma(MyText)


	MyText = Replace(MyText, ",", ". ")

	MyText = Replace(MyText, vbCrLf, ".")

	MyText = Replace(MyText, vbCr, ".")

	MyText = Replace(MyText, vbLf, ".")

	MyText = Replace(MyText, vbNewLine, ".")

	QuoteComma = Chr(34) & MyText & Chr(34) & ","


End Function


Function QuoteCommaNoReplace(MyText)


	MyText = Replace(MyText, ",", "")

	MyText = Replace(MyText, vbCrLf, "")

	MyText = Replace(MyText, vbCr, "")

	MyText = Replace(MyText, vbLf, "")

	MyText = Replace(MyText, vbNewLine, "")

	QuoteCommaNoReplace = Chr(34) & MyText & Chr(34) & ","


End Function


Sub ExportCalendar()


	Dim strCalendar As String

	Dim csvCalendar As String

	Dim varResult As Variant

	Dim nms As NameSpace


	Set nms = Application.GetNamespace("MAPI")


	Set colCalendar = nms.GetDefaultFolder(olFolderCalendar)

	Set colAppts = colCalendar.Items


	colAppts.Sort "[Start]", False

	colAppts.IncludeRecurrences = True

	strSearch = "[Start] <= " & Quote(Format(Now + 30, "ddddd") & " 11:59 PM") & " AND [End] > " & Quote(Format(Now, "ddddd") & " 12:00 AM")


	Set objItem = colAppts.Find(strSearch)

	Set objAllItems = colAppts.Restrict(strSearch)


	strCalendar = QuoteComma("Subject") & QuoteComma("Start Date") & QuoteComma("Start Time") & QuoteComma("End Date") & QuoteComma("End Time") & QuoteComma("Description") & Quote("Location")


	For Each itmAppt In objAllItems

		strCalendar = strCalendar & vbCrLf

		strCalendar = strCalendar & QuoteComma(itmAppt.Subject)

		strCalendar = strCalendar & QuoteComma(Format(itmAppt.Start, "dd/mm/yyyy"))

		strCalendar = strCalendar & QuoteComma(Format(itmAppt.Start, "hh:mm"))

		strCalendar = strCalendar & QuoteComma(Format(itmAppt.End, "dd/mm/yyyy"))

		strCalendar = strCalendar & QuoteComma(Format(itmAppt.End, "hh:mm"))

		strCalendar = strCalendar & QuoteComma(itmAppt.Body)

		strCalendar = strCalendar & Quote(itmAppt.Location)

	Next itmAppt


	csvCalendar = "c:\Outlook\calendar.csv"

	fnum = FreeFile()

	Open csvCalendar For Output As fnum

	Print #fnum, strCalendar

	Close #fnum


End Sub


Sub ExportContacts()


	Dim strContacts As String

	Dim varResult As Variant

	Dim nms As NameSpace

	Dim colContacts

	Dim itmContact As Outlook.ContactItem


	Set nms = Application.GetNamespace("MAPI")


	Set colContacts = nms.GetDefaultFolder(olFolderContacts).Items


	ItemCount = colContacts.Count

	If ItemCount = 0 Then

		MsgBox "No contacts to export"

		Exit Sub

	End If


	'CSV Header

	strContacts = QuoteComma("First Name") & QuoteComma("Last Name") & QuoteComma("E-mail Address") & QuoteComma("Mobile Phone") & Quote("Business Phone")


	'Contact details

	For Each itmContact In colContacts

		strContacts = strContacts & vbCrLf

		strContacts = strContacts & QuoteComma(itmContact.FirstName)

		strContacts = strContacts & QuoteComma(itmContact.LastName)

		strContacts = strContacts & QuoteCommaNoReplace(itmContact.Body)

		strContacts = strContacts & QuoteComma(itmContact.MobileTelephoneNumber)

		strContacts = strContacts & Quote(itmContact.BusinessTelephoneNumber)

	Next


	'Create/Overwrite file

	csvContacts = "c:\Outlook\contacts.csv"

	fnum = FreeFile()

	Open csvContacts For Output As fnum

	Print #fnum, strContacts

	Close #fnum



End Sub


Sub SendEmail()


	Dim objOutlook As Outlook.Application

	Dim objOutlookMsg As Outlook.MailItem


	csvContacts = "c:\Outlook\contacts.csv"

	csvCalendar = "c:\Outlook\calendar.csv"


	' Create the Outlook session.

	Set objOutlook = CreateObject("Outlook.Application")

	' Create the message.

	Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

	With objOutlookMsg

		.Recipients.Add ("[email protected]")

		.Attachments.Add (csvContacts)

		.Attachments.Add (csvCalendar)

		.Subject = "Outlook data"

		.Body = "Contacts and Calendar"

		.Display

	End With


	Set objOutlook = Nothing


End Sub

[Guest chucky.egg]

I've come up with a slightly improved process, based on the current Google contacts setup

Sub ExportContacts()


	Dim strContacts As String

	Dim varResult As Variant

	Dim nms As NameSpace

	Dim colContacts

	Dim itmContact As Outlook.ContactItem


	Set nms = Application.GetNamespace("MAPI")


	Set colContacts = nms.GetDefaultFolder(olFolderContacts).Items


	ItemCount = colContacts.Count

	If ItemCount = 0 Then

		MsgBox "No contacts to export"

		Exit Sub

	End If


	'Field order:

	'Name

	'Section 1 - Description

	'Section 1 - Email

	'Section 1 - Phone

	'Section 1 - Mobile

	'Section 1 - Address

	'Section 1 - Company

	'Section 1 - Title


	'CSV Header

	strContacts = QuoteComma("Name") & QuoteComma("Section 1 - Description") & QuoteComma("Section 1 - Email") & QuoteComma("Section 1 - Phone") & QuoteComma("Section 1 - Mobile") & QuoteComma("Section 1 - Address") & QuoteComma("Section 1 - Company") & Quote("Section 1 - Title")


	'Contact details

	For Each itmContact In colContacts

		strContacts = strContacts & vbCrLf

		strContacts = strContacts & QuoteComma(itmContact.FirstName & " " & itmContact.LastName)  'Single name field

		strContacts = strContacts & QuoteComma("Work")											'Section description (always "Work")

		strContacts = strContacts & QuoteCommaNoReplace(itmContact.Body)						  'Work Email address

		strContacts = strContacts & QuoteComma(itmContact.BusinessTelephoneNumber)				'Work phone number

		strContacts = strContacts & QuoteComma(itmContact.MobileTelephoneNumber)				  'Mobile phone number

		strContacts = strContacts & QuoteCommaNoReplace(itmContact.BusinessAddress)			   'Address

		strContacts = strContacts & QuoteComma(itmContact.CompanyName)							'Company name

		strContacts = strContacts & Quote(itmContact.JobTitle)									'Job title

	Next


	'Create/Overwrite file

	csvContacts = "c:\Outlook\contacts.csv"

	fnum = FreeFile()

	Open csvContacts For Output As fnum

	Print #fnum, strContacts

	Close #fnum



End Sub

[Guest colonel_butt]

Best to buy commerical software to sync:

http://www.companionlink.com/products/comp...kforgoogle.html

rgds

[Guest chucky.egg]

I don't agree - why pay when you can do it for free?

Besides, my office setup won't allow me to install apps or export Contacts from Outlook. Using VBA I can have the functionality I want (apart from automation!)