Import Contacts from Outlook

Home | Invoicing | Resume | Feedback | Guestbook | Personal Pages | Other Web Sites | Anything from Amazon!

Domino Anti-SPAM Excel Export via Notes Excel Export via the Web Export Contacts to Outlook Import Contacts from Outlook Mail Blaster Improved Mailing List XML Name Picker File Sending Agent Launch File Attachments Fix Document Field Agent Installing R4.x on NT Make Lotus your Mailto: Client Mail Purge Agent Server Message Broadcast RFC822 Internet Email Addressing SMTP Inbound Font for R5 Tricks with the HTTPD.CNF


Adding this code as an agent within your local NAB (or, with newer versions of Notes your Mail File) will import all contacts from Outlook into person (contact) documents in Notes.

If you want/need additional mappings , all I can say is have fun! Oh yeah, no warranties, please donate, etc... since I see people screaming for this functionality all the time. BTW, you can put this in a button too, for when you, as the admin, want to send this message to your users who just migrated. No error checking, thats your problemo...

Credits go out to Wolfgang Flamme for some great updates and bugfixes...

-------- Cut Here --------

Sub Initialize

Const olContactsFolder = 10
Const olContactItem = 2
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
Dim OL As Variant
Dim OLContact As Variant
Dim number As Integer
number = 1
Set db = session.CurrentDatabase
Set doc = New NotesDocument(db)
Print "Connecting to Outlook..."
Print "Opening ..."
Set OL = CreateObject("Outlook.Application")
Set myNS = OL.GetNameSpace("MAPI")
'For the next two lines, using the GetDefaultFolder will always open up the default
'Contacts folder, while the PickFolder line prompts for a folder.
' Set myFolder = myNS.GetDefaultFolder (olContactsFolder)
Set myFolder = myNS.PickFolder()
Set myItems = myFolder.Items
Set myItem= myItems.GetFirst

Print "Starting import from Outlook file..."

For x = 1 To myItems.count
Set doc = db.CreateDocument
With myItem
doc.mailaddress = .email1address
doc.firstname = .firstname
doc.lastname = .lastname
doc.title = .title
doc.FirstName = .FirstName
doc.MiddleInitial = .MiddleName
doc.Suffix = .Suffix
doc.CompanyName = .CompanyName
doc.Department = .Department
doc.JobTitle = .JobTitle
doc.OfficeStreetAddress = .BusinessAddressStreet
doc.OfficeState = .BusinessAddressState
doc.OfficeZip = .BusinessAddressPostalCode
doc.OfficeCountry = .BusinessAddressCountry
doc.StreetAddress = .HomeAddressStreet
doc.City = .HomeAddressCity
doc.State = .HomeAddressState
doc.Zip = .HomeAddressPostalCode
doc.Country = .HomeAddressCountry
doc.OfficeFAXPhoneNumber = .BusinessFaxNumber
doc.OfficePhoneNumber = .BusinessTelePhoneNumber
doc.CellPhoneNumber = .MobilePhoneNumber
doc.HomeFaxPhoneNumber = .HomeFaxNumber
doc.PhoneNumber = .HomeTelePhoneNumber
doc.PhoneNumber_6 = .PagerNumber
doc.Assistant = .AssistantName
doc.Birthday = .Birthday
doc.Categories = .Categories
doc.Children = .Children
doc.MailAddress = .Email1Address
doc.Keywords = .Categories
doc.Location = .OfficeLocation
doc.Manager = .ManagerName
' doc.Comment = .Notes
doc.Spouse = .Spouse
doc.WebSite = .WebPage
doc.OLItemID=.StoreID
doc.OLEntryID=.EntryID
Set rtitem = doc.GetFirstItem( "Body" )
Call rtitem.AppendText(myItem.Body)

End With
doc.form = "Person"
doc.Type = "Person"
success = doc.ComputeWithForm( False, False )
Call doc.Save( True, True )
number=number+1
Set myItem= myItems.GetNext

Print "Completed : " & number
Next

Print "Disconnecting from Outlook..."
Set myNS = Nothing
Set myFolder = Nothing
Set myItems = Nothing
Set myItem = Nothing
ol.quit
End Sub