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

This code is from Wolfgang Flamme and is handy for when you go away from Notes...

Of course, this is to be used within a VB environment, this is not LotusScript!!!

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

Option Base 0

Private Sub CommandButton1_Click()
'Converts all Notes R5 addressbooks to OL contacts
'V1.0 beta (2001-07-08)
'by Wolfgang Flamme
'wflamme @ mainz-NoOnSlPiAnMe.de (Remove the NOSPAM)
'-----
Const TEMP_FOLDER = "c:\temp\" 'change this if neccessary
Const OL_MSGCLASS="IPM.Contact" 'change this for customized contact forms

Dim lnsession As NotesSession
Dim lnae As NotesDocument
Set lnsession = CreateObject("Lotus.NotesSession")
lnsession.initialize

lnabs = lnsession.AddressBooks

Set olns = Application.GetNamespace("MAPI")
Set olfld = olns.PickFolder()

For Each lnab In lnabs
lnab.Open
Set lnaes = lnab.Search("Form=""Person""", Nothing, 0)
Set lnae = lnaes.GetFirstDocument
While Not lnae Is Nothing
Set itm = olfld.Items.Add(OL_MSGCLASS)
itm.LastName = CStr(lnae.GetItemValue("LastName")(0))
itm.FirstName = CStr(lnae.GetItemValue("FirstName")(0))
itm.MiddleName = CStr(lnae.GetItemValue("MiddleInitial")(0))
itm.Title = CStr(lnae.GetItemValue("Title")(0))
aa = lnae.GetItemValue("Birthday")(0)
If aa <> "" Then itm.Birthday = aa
itm.Spouse = CStr(lnae.GetItemValue("Spouse")(0))
itm.Children = CStr(lnae.GetItemValue("Children")(0))

itm.HomeAddressCountry = CStr(lnae.GetItemValue("Country")(0))
itm.HomeAddressPostalCode = CStr(lnae.GetItemValue("Zip")(0))

lnaeaddress = CStr(lnae.GetItemValue("HomeAddress")(0))
If lnaeaddress <> "" Then
a = InStr(lnaeaddress, vbCrLf)
If a > 0 Then
itm.HomeAddressStreet = Left(lnaeaddress, a - 1)
itm.HomeAddressCity = Right(lnaeaddress, Len(lnaeaddress)
- a)
End If
End If


itm.JobTitle = CStr(lnae.GetItemValue("JobTitle")(0))
itm.CompanyName = CStr(lnae.GetItemValue("CompanyName")(0))
itm.Department = CStr(lnae.GetItemValue("Department")(0))
itm.OfficeLocation = CStr(lnae.GetItemValue("Location")(0))

itm.BusinessAddressCountry =
CStr(lnae.GetItemValue("OfficeCountry")(0))
itm.BusinessAddressPostalCode =
CStr(lnae.GetItemValue("OfficeZip")(0))

lnaeaddress = CStr(lnae.GetItemValue("BusinessAddress")(0))
If lnaeaddress <> "" Then
a = InStr(lnaeaddress, vbCrLf)
If a > 0 Then
itm.BusinessAddressStreet = Left(lnaeaddress, a - 1)
itm.BusinessAddressCity = Right(lnaeaddress,
Len(lnaeaddress) - a)
End If
End If


itm.ManagerName = CStr(lnae.GetItemValue("Manager")(0))
itm.AssistantName = CStr(lnae.GetItemValue("Assistant")(0))
itm.BusinessTelephoneNumber =
CStr(lnae.GetItemValue("OfficePhoneNumber")(0))
itm.BusinessFaxNumber =
CStr(lnae.GetItemValue("OfficeFaxNumber")(0))
itm.MobileTelephoneNumber =
CStr(lnae.GetItemValue("CellPhoneNumber")(0))
itm.HomeTelephoneNumber =
CStr(lnae.GetItemValue("PhoneNumber")(0))

itm.Email1Address = CStr(lnae.GetItemValue("MailAddress")(0))
itm.WebPage = CStr(lnae.GetItemValue("WebSite")(0))


lnaecats = lnae.GetItemValue("Categories")
If UBound(lnaecats) > 0 Then
olcat = ""
For Each lnaecat In lnaecats
olcat = olcat & lnaecat & "; "
Next
itm.Categories = Left$(olcat, Len(olcat) - 2)
End If

itm.Body = CStr(lnae.GetItemValue("Comment")(0))

Set lnrt = lnae.GetFirstItem("Comment")
If (lnrt.Type = RICHTEXT) Then
For Each lnrteo In lnrt.EmbeddedObjects
If (lnrteo.Type = EMBED_ATTACHMENT) Then
lnatn = lnrteo.Source
Call lnrteo.ExtractFile(TEMP_FOLDER & lnatn)
itm.Attachments.Add TEMP_FOLDER & lnatn, olByValue, 1
End If
Next
End If

'----
itm.Save
Set lnae = lnaes.GetNextDocument(lnae)
Wend
Next
End Sub