Exporting LDIF from Outlook

[Walker Joe <Joe.Walker@barclaycard.co.uk>]

Hi,

This is a simple add-in for outlook 2000 (not tried it on 98 or earlier)
that exports your address-book as an ldif file for use with openldap. You
would need some simple understanding of outlook/VBA to use it.

I'm not sure where (or if) you would include it with openldap, but if you
want to, some may find it useful when moving from windows to unix.

Comments?

Joe


#!/bin/sh

--
' Copyright 2000, Joe Walker <joe@eireneh.com>, All rights reserved.
' This is free software; you can redistribute and use it
' under the same terms as OpenLDAP itself.

Option Explicit

Private addout As Integer

' Change this to be wherever you want to write to:
Private Const ADDFILE As String = "S:\joe\ldapadd.ldif"
Private Const ROOT As String = "dc=domain, dc=com"

' You can then read this in using something like this:
'#!/bin/sh
'
'FILE=/home/joe/ldapadd.ldif
'ROOT="dc=domain, dc=com"
'
'echo "Password required for $ROOT."
'echo "Warning: password will be echoed to terminal."
'echo ""
'echo -n "password: "
'read PASS
'
'echo "Deleting old entries ..."
'ldapsearch -b "$ROOT" "(objectclass=*)" dn |
'    grep -v "^$ROOT$" |
'    grep -v "^cn=Manager, $ROOT$" |
'    grep -v "^$" |
'    ldapdelete -D "cn=Manager, $ROOT" -w $PASS -c
'
'echo "Adding entries from $FILE ..."
'cat $FILE |
'    dos2unix |
'    ldapadd -D "cn=Manager, $ROOT" -w $PASS -c |
'    grep -v "^$"
'
'#ldapsearch -L -b "$ROOT" "(objectclass=*)"

'---------------------------------------------------------------------------
-----

Sub LDIFExport()

  Dim contacts As mapifolder
  Dim contact As ContactItem

  Set contacts = GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)

  InitOutput

  For Each contact In contacts.Items
    FieldOutput "dn", "cn=" + contact.FirstName + " " + contact.LastName + _
                ", " + ROOT
    FieldOutput "te", contact.LastFirstSpaceOnly
    FieldOutput "cn", contact.FirstName
    FieldOutput "sn", contact.LastName

    FieldOutput "mail", contact.Email1Address
    FieldOutput "homePhone", contact.HomeTelephoneNumber
    FieldOutput "pager", contact.PagerNumber
    FieldOutput "mobile", contact.MobileTelephoneNumber
    FieldOutput "web", contact.WebPage
    FieldOutput "telephoneNumber", contact.BusinessTelephoneNumber
    FieldOutput "officeFAX", contact.BusinessFaxNumber
    FieldOutput "title", contact.Title
    FieldOutput "department", contact.Department
    FieldOutput "physicalOfficeDeliveryName", contact.OfficeLocation
    FieldOutput "organizationName", contact.CompanyName
    FieldOutput "URL", contact.BusinessHomePage
    FieldOutput "givenName", contact.FirstName
    FieldOutput "initials", contact.MiddleName
    FieldOutput "sn", contact.LastName
    FieldOutput "nickname", contact.NickName
    FieldOutput "homePostalAddress", contact.HomeAddress
    FieldOutput "city", contact.HomeAddressCity
    FieldOutput "otherFacsimilieTelephoneNumber", contact.OtherFaxNumber
    FieldOutput "postalAddress", contact.BusinessAddress
    FieldOutput "l", contact.BusinessAddressCity
    FieldOutput "st", contact.BusinessAddressState
    FieldOutput "postalCode", contact.BusinessAddressPostalCode
    FieldOutput "countryName", contact.BusinessAddressCountry
    FieldOutput "department", contact.Department
    FieldOutput "info", contact.Body
    FieldOutput "objectclass", "person"
    FieldOutput "objectclass", "organizationalPerson"
    ObjectEnd
  Next

  DeInitOutput

End Sub


'---------------------------------------------------------------------------
-----

Sub FieldOutput(ldifprop As String, olprop As String)

  Dim newolprop As String
  Dim i As Integer
  Dim temp As String

  newolprop = Trim(olprop)
  newolprop = Swap(newolprop, vbCrLf, "$")
  newolprop = Swap(newolprop, vbCr, "$")
  newolprop = Swap(newolprop, vbLf, "$")
  newolprop = Swap(newolprop, " ,", ",")
  newolprop = Swap(newolprop, " & ", " and ")
  newolprop = Trim(newolprop)

  If newolprop = "" Then
    Exit Sub
  End If

  AddOutput Trim(ldifprop) + ": " + newolprop

End Sub


'---------------------------------------------------------------------------
-----

Function Swap(orig As String, from As String, repl As String) As String

  Dim pos As Integer

  Swap = orig

  Do

    pos = InStr(Swap, from)

    If pos = 0 Then
      Exit Do
    End If

    Swap = Mid$(Swap, 1, pos - 1) & repl & Mid$(Swap, pos + Len(from))

  Loop

End Function


'---------------------------------------------------------------------------
-----

Sub ObjectEnd()

  AddOutput ""

End Sub


'---------------------------------------------------------------------------
-----

Sub AddOutput(line As String)

  Print #addout, line

End Sub


'---------------------------------------------------------------------------
-----

Sub InitOutput()

  addout = FreeFile
  Open ADDFILE For Output As #addout

End Sub


'---------------------------------------------------------------------------
-----

Sub DeInitOutput()

  Close #addout

End Sub


'---------------------------------------------------------------------------
-----



Legal Disclaimer:-

Please be aware that messages sent over
the Internet may not be secure and should
not be seen as forming a legally binding
contract unless otherwise stated.