
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