A Microsoft Office (Excel, Word) forum. OfficeFrustration

If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below.

Go Back   Home » OfficeFrustration forum » Microsoft Access » General Discussion
Site Map Home Register Authors List Search Today's Posts Mark Forums Read  

Importing Contacts From MS Outlook



 
 
Thread Tools Display Modes
  #1  
Old March 24th, 2010, 11:34 PM posted to microsoft.public.access
kenista
external usenet poster
 
Posts: 17
Default Importing Contacts From MS Outlook

I am using Access 2007 and Outlook 2007. I am trying to import selected
contacts from my address book into a table in my database called
ContactPeople.

The table has the following fields:
ID - primary key & autonumbered
FirstName
LastName
CompanyName
TelephoneNumber
FaxNumber
MobileNumber
EmailAddress

I have tried a few things, including creating the module below, but am
unable to get any fields to populate.
Sub ImportContactsFromOutlook()

' This code is based in Microsoft Access.

' Set up DAO objects (uses existing "ContactPeople" table)
Dim rst As DAO.Recordset
Dim iNumContacts As Long
Dim i As Long

Set rst = CurrentDb.OpenRecordset("OLContacts")

' Set up Outlook objects.
Dim ol As New Outlook.Application
Dim olns As Outlook.NameSpace
Dim cf As Outlook.MAPIFolder
Dim c As Outlook.ContactItem
Dim objItems As Outlook.Items

Set olns = ol.GetNamespace("MAPI")
Set cf = olns.GetDefaultFolder(olFolderContacts)
Set objItems = cf.Items
iNumContacts = objItems.Count
If iNumContacts 0 Then
For i = 1 To iNumContacts
If TypeName(objItems(i)) = "ContactItem" Then
Set c = objItems(i)
' If c.Categories = "Importthisone" Then 'I only need certain
categories
rst.AddNew
' Pick up all the fields you want here
rst!FirstName = c.FirstName
rst!LastName = c.LastName
rst!CompanyName = c.CompanyName
rst!EmailAddress = c.EmailAddress
rst.Update
End If
' End If
Next i
rst.Close
Else
MsgBox "No contacts to import"
End If

End Sub

Please help
  #2  
Old March 25th, 2010, 02:27 AM posted to microsoft.public.access
Arvin Meyer [MVP][_2_]
external usenet poster
 
Posts: 2,310
Default Importing Contacts From MS Outlook

Eithout spending a lot of time discussing the relative merits of using code
for what you want to do, I suggest that you use the Outlook interface to
export all the contacts into a new empty database. Then sort what you want
and delete what you don't want, then import the clean data into your
database. It should take less than 15 or 20 minutes run run, sort, delete,
then import into the new db.
--
Arvin Meyer, MCP, MVP
http://www.datastrat.com
http://www.accessmvp.com
http://www.mvps.org/access


"kenista" wrote in message
...
I am using Access 2007 and Outlook 2007. I am trying to import selected
contacts from my address book into a table in my database called
ContactPeople.

The table has the following fields:
ID - primary key & autonumbered
FirstName
LastName
CompanyName
TelephoneNumber
FaxNumber
MobileNumber
EmailAddress

I have tried a few things, including creating the module below, but am
unable to get any fields to populate.
Sub ImportContactsFromOutlook()

' This code is based in Microsoft Access.

' Set up DAO objects (uses existing "ContactPeople" table)
Dim rst As DAO.Recordset
Dim iNumContacts As Long
Dim i As Long

Set rst = CurrentDb.OpenRecordset("OLContacts")

' Set up Outlook objects.
Dim ol As New Outlook.Application
Dim olns As Outlook.NameSpace
Dim cf As Outlook.MAPIFolder
Dim c As Outlook.ContactItem
Dim objItems As Outlook.Items

Set olns = ol.GetNamespace("MAPI")
Set cf = olns.GetDefaultFolder(olFolderContacts)
Set objItems = cf.Items
iNumContacts = objItems.Count
If iNumContacts 0 Then
For i = 1 To iNumContacts
If TypeName(objItems(i)) = "ContactItem" Then
Set c = objItems(i)
' If c.Categories = "Importthisone" Then 'I only need certain
categories
rst.AddNew
' Pick up all the fields you want here
rst!FirstName = c.FirstName
rst!LastName = c.LastName
rst!CompanyName = c.CompanyName
rst!EmailAddress = c.EmailAddress
rst.Update
End If
' End If
Next i
rst.Close
Else
MsgBox "No contacts to import"
End If

End Sub

Please help



 




Thread Tools
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

vB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Forum Jump


All times are GMT +1. The time now is 06:20 PM.


Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 OfficeFrustration.
The comments are property of their posters.