[Date Prev][Date Next]
[Chronological]
[Thread]
[Top]
Re: Exporting LDIF from Outlook
Hi,
I want to contribute to the article of Joe Walker from 2000.
I have added some functionality to his Exporting LDIF from Outlook VBA
Script, and I think that I have made some corrections that were at least
needed in my openldap V2 installation on a SuSE 8.1 Linux.
The major changes I made are the attributes in Joe's script that did not
comply with the corresponding rfc's
and that of cause leaded to errors. Some more errors occurred because the
Outlook data in my contact folder was not very well in order. I made some
provisions in the script to deal with these problems.
And I have build in some logic for german umlauts and some french letters
that I needed for the names that are in my contacts folder.
I would greatly appreciate if there would be somebody who still improves
this piece of code that at least exported my own data very well.
The first thing I did was to insert the schema definitions
/etc/openldap/schema/core.schema /etc/openldap/schema/cosine.schema
/etc/openldap/schema/inetorgperson.schema
in the slapd.conf file.
Then I exported my addresses from the Outlook contact folder using the macro
LDIFExport of the macro package that follows. The Script puts everything in
the file
C:\TEMP\Adressen.ldif
In order to use the script you will have to change the variable "Root" in
order to fit your data.
I have also added a macro LDIFDelete that will produce a file as input for
ldapmodify in order to delete all the entries that are in the contacts
folder of Outlook from the LDAP database. I found it handy for my
experiments with my chaotic data.
By the way: My Outlook version is Outlook 2002 SP 2. You have to activate
script execution in order to use this script.
Of course you may use my version of the script under the same conditions as
the previous version.
Here is the Script:
---------------------- schnipp ---------------
Dim addout As Integer
Sub LDIFDelete()
Dim contacts As MAPIFolder
Dim contact As ContactItem
Dim Root As String
Dim Eigenschaft As String
Root = "ou=contacts,dc=example,dc=com"
Set contacts = GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
InitOutput
For Each contact In contacts.Items
Eigenschaft = contact.FirstName + " " + contact.LastName
If Trim(Eigenschaft) = "" Then
Eigenschaft = contact.CompanyName
End If
If Trim(Eigenschaft) <> "" Then
FieldOutput "dn", "cn=" + Eigenschaft + _
", " + Root
FieldOutput "changetype", "delete"
End If
ObjectEnd
Next
DeInitOutput
End Sub
Sub LDIFExport()
Dim contacts As MAPIFolder
Dim contact As ContactItem
Dim Root As String
Dim Eigenschaft As String
Root = "ou=contacts,dc=example,dc=com"
Set contacts = GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
InitOutput
For Each contact In contacts.Items
Eigenschaft = Trim(contact.FirstName)
If Eigenschaft <> "" Then
Eigenschaft = Eigenschaft + " "
End If
Eigenschaft = Eigenschaft + Trim(contact.LastName)
If Trim(Eigenschaft) = "" Then
Eigenschaft = contact.CompanyName
End If
If Trim(Eigenschaft) <> "" Then
FieldOutput "dn", "cn=" + Eigenschaft + _
", " + Root
' FieldOutput "te", contact.LastFirstSpaceOnly
FieldOutput "cn", Eigenschaft
FieldOutput "givenName", contact.FirstName
If Trim(contact.LastName) <> "" Then
FieldOutput "sn", contact.LastName
ElseIf Trim(contact.CompanyName) <> "" Then
FieldOutput "sn", contact.CompanyName
Else
FieldOutput "sn", "unknown"
End If
FieldOutput "cn", contact.NickName
FieldOutput "title", contact.Title
FieldOutput "mail", contact.Email1Address
FieldOutput "mail", contact.Email2Address
FieldOutput "mail", contact.Email3Address
FieldOutput "homePhone", contact.HomeTelephoneNumber
FieldOutput "mobile", contact.MobileTelephoneNumber
FieldOutput "labeledURI", contact.WebPage
FieldOutput "telephoneNumber", contact.BusinessTelephoneNumber
FieldOutput "facsimileTelephoneNumber", contact.BusinessFaxNumber
FieldOutput "physicalOfficeDeliveryName", contact.OfficeLocation
FieldOutput "ou", contact.CompanyName
FieldOutput "description", contact.BusinessHomePage
' FieldOutput "", contact.MiddleName
FieldOutput "homePostalAddress", contact.HomeAddress
FieldOutput "facsimileTelephoneNumber", contact.OtherFaxNumber
FieldOutput "postalAddress", contact.BusinessAddress
FieldOutput "st", contact.BusinessAddressState
If contact.BusinessAddressPostalCode <> "" Then
FieldOutput "postalCode", contact.BusinessAddressPostalCode
FieldOutput "l", contact.BusinessAddressCity
Else
FieldOutput "postalCode", contact.HomeAddressPostalCode
FieldOutput "l", contact.HomeAddressCity
End If
If contact.BusinessAddressCountry <> "" Then
FieldOutput "ou", contact.BusinessAddressCountry
Else
FieldOutput "ou", contact.HomeAddressCountry
End If
FieldOutput "ou", contact.Department
' FieldOutput "description", contact.Body
FieldOutput "objectclass", "person"
FieldOutput "objectclass", "organizationalPerson"
FieldOutput "objectclass", "inetOrgPerson"
End If
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 = Swap(newolprop, "ö", "oe")
newolprop = Swap(newolprop, "ä", "ae")
newolprop = Swap(newolprop, "ü", "ue")
newolprop = Swap(newolprop, "Ü", "Ue")
newolprop = Swap(newolprop, "Ö", "Oe")
newolprop = Swap(newolprop, "Ä", "Ae")
newolprop = Swap(newolprop, "ß", "ss")
newolprop = Swap(newolprop, "é", "e")
newolprop = Swap(newolprop, "ó", "o")
newolprop = Swap(newolprop, "à", "a")
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 "C:\Temp\Adressen.ldif" For Output As addout
End Sub
Sub DeInitOutput()
Close addout
End Sub
------------------ schnipp -------------------------
I hope that my improvements may help you somehow.
With regards,
Gerd Koslowski