Comment récupérer le carnet d'adresse Lotus en VB

Bonjour,

Export name.nsf vers Access, code LotusScript à mettre dans un agent ou une bibliothèque de script :

Option Public
Uselsx "*LSXODBC"

Sub expvdatamdb(pnab As String, pmdb As String)
Dim strDB As String 'Initialize string to database path.
strDB = pmdb ' this is a directory you have
'Create new instance of Microsoft Access
Set appAccess = CreateObject("Access.Application")

'Open database in Microsoft Access window
appAccess.NewCurrentDatabase(strDB) 'Get Database variable.

Set dbs = appAccess.CurrentDB()
Set tdf = dbs.CreateTableDef("Contacts") 'Create new table.

'Create field in new table.
dbText = 10
Set fld = tdf.CreateField("Salutation",dbText,100)

'Append Field and TableDef objects.
tdf.FIELDS.Append fld
dbs.TableDefs.Append tdf
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("FirstName",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("MiddleInitial",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("LastName",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh


Set fld = tdf.CreateField("Suffix",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("Title",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("CompanyName",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("BusinessAddress",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("BusinessZip",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("BusinessAddressCountry",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("OfficeLocation",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("Department",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("HomeAddress",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("HomeZip",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("HomeAddressCountry",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("OfficePhoneNumber",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("OfficeFaxPhoneNumber",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("CellPhoneNumber",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("Pager",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("HomePhoneNumber",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("HomeFaxPhoneNumber",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("EmailAddress",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("WebPage",dbText,150)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("BirthDay",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("Spouse",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("Children",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("AssistantName",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Set fld = tdf.CreateField("ManagerName",dbText,100)
tdf.FIELDS.Append fld
dbs.TableDefs.Refresh

Dim workspace As New NotesUIWorkspace
Set session = New NotesSession
Set db = session.GetDatabase("",pnab)
Set view = db.GetView("People")

Set r = dbs.openrecordset("Contacts")

Set doc = view.GetFirstDocument
While Not(doc Is Nothing)
With r
.AddNew
If doc.Title(0)<>"" Then .Salutation=doc.Title(0)
If doc.FirstName(0)<>"" Then .FirstName=doc.FirstName(0)
If doc.MiddleInitial(0)<>"" Then .MiddleInitial=doc.MiddleInitial(0)
If doc.LastName(0)<>"" Then .LastName=doc.LastName(0)
If doc.Suffix(0)<>"" Then .Suffix=doc.Suffix(0)

If doc.CompanyName(0)<>"" Then .CompanyName=doc.CompanyName(0)
If doc.JobTitle(0)<>"" Then .Title=doc.JobTitle(0)

If doc.BusinessAddress(0)<>"" Then .BusinessAddress=doc.BusinessAddress(0)
If doc.OfficeZip(0)<>"" Then .BusinessZip=doc.OfficeZip(0)
If doc.OfficeCountry(0)<>"" Then .BusinessAddressCountry=doc.OfficeCountry(0)

If doc.HomeAddress(0)<>"" Then .HomeAddress=doc.HomeAddress(0)
If doc.Zip(0)<>"" Then .HomeZip=doc.Zip(0)
If doc.Country(0)<>"" Then .HomeAddressCountry=doc.Country(0)

If doc.OfficePhoneNumber(0)<>"" Then .OfficePhoneNumber=doc.OfficePhoneNumber(0)
If doc.OfficeFaxPhoneNumber(0)<>"" Then .OfficeFaxPhoneNumber = doc.OfficeFaxPhoneNumber(0)

If doc.PhoneNumber_6(0)<>"" Then .Pager = doc.PhoneNumber_6(0)
If doc.CellPhoneNumber(0)<>"" Then .CellPhoneNumber = doc.CellPhoneNumber(0)
If doc.PhoneNumber(0)<>"" Then .HomePhoneNumber = doc.PhoneNumber(0)
If doc.HomeFaxPhoneNumber(0)<>"" Then .HomeFaxPhoneNumber = doc.HomeFaxPhoneNumber(0)

If doc.MailAddress(0)<>"" Then .EMailAddress = doc.MailAddress(0)
If doc.WebSite(0)<>"" Then .WebPage = doc.WebSite(0)
If doc.Birthday(0)<>"" Then .BirthDay= doc.Birthday(0)
If doc.Spouse(0)<>"" Then .Spouse=doc.Spouse(0)
If doc.children(0)<>"" Then .Children=doc.Children(0)
If doc.Assistant(0)<>"" Then .AssistantName=doc.Assistant(0)
If doc.Manager(0)<>"" Then .ManagerName=doc.Manager(0)
If doc.location(0)<>"" Then .OfficeLocation=doc.Location(0)
If doc.Department(0)<>"" Then .Department=doc.Department(0)
.Update
End With
Set doc = view.GetNextDocument(doc)
Wend
r.close
End Sub

--

Cordialement

Stéphane Maillard
"Benoit" <benoit.laroche@free.fr> a écrit dans le message de news:02dd01c3414a$98b722b0$a001280a@phx.gbl...
Bonjour à tous,
Je souhaite récupérer le carnet d'adresse lotus Notes dans
une table pour gérer les destinataires de mes mails dans
mon application VB.
Comment peut on récupérer ce carnet d'adresse simplement.
D'avance merci,
Benoît