Exportation d'un carnet d'adresse perso vers Excel

[Philippe]

Quelqu'un saurait il me donner la recette pour exporter l'intégralité du carnet d'adresse perso vers Excel pour pouvoir ensuite le remonter dans outlook ou autre.Merci d'avance.

[Stephane Maillard]

Bonjour,Voici deux codes.Export de la vue People vers Outlook :Sub exppnaboutlook(pnab As String) Dim session As New notessession Dim db As notesdatabase Set db = session.GetDatabase("",pnab) Dim doc As notesdocument Dim exvname As String Dim exshname As String exvname = "People" Dim view As notesview Set view= db.getview (exvname) ' Set Outlook object Set Application = CreateObject("Outlook.Application") Set myNameSpace = Application.GetNameSpace("MAPI") Set myFolder = myNameSpace.GetDefaultFolder(10) Set myItem = Application.CreateItem(2) Set doc = view.getfirstdocument Do While Not (doc Is Nothing) Set myItem = Application.CreateItem(2) With myItem .FullName =doc.FirstName(0) + " " + doc.MiddleInitial(0) + " " + doc.LastName(0) .Suffix=doc.Suffix(0) .Title=doc.Title(0) .JobTitle = doc.JobTitle(0) .CompanyName = doc.CompanyName(0) .BusinessTelephoneNumber = doc.OfficePhoneNumber(0) .BusinessFaxNumber = doc.OfficeFaxPhoneNumber(0) .MobileTelephoneNumber = doc.CellPhoneNumber(0) .Email1Address = doc.MailAddress(0) .WebPage = doc.WebSite(0) If (doc.Birthday(0) <> " " And doc.Birthday(0) <> "") Then .Birthday=doc.Birthday(0) .PagerNumber=doc.PhoneNumber_6(0) .HomeTelephoneNumber=doc.PhoneNumber(0) .HomeAddress=doc.HomeAddress(0) .HomeAddressPostalCode=doc.Zip(0) .HomeAddressCountry=doc.Country(0) .HomeFaxNumber=doc.HomeFaxPhoneNumber(0) .BusinessAddress=doc.BusinessAddress(0) .BusinessAddressPostalCode=doc.OfficeZip(0) .BusinessAddressCountry=doc.OfficeCountry(0) .Spouse=doc.Spouse(0) .Children=doc.Children(0) .AssistantName=doc.Assistant(0) .ManagerName=doc.Manager(0) .OfficeLocation=doc.Location(0) .Department=doc.Department(0)' Display contact To user .save ' .quit End With ' Close object references. Set doc = view.getnextdocument(doc) Loop Application.quit End Sub'--Fin codeExport vers Excel :Sub exppnabdata(pnab As String) Dim session As New notessession Dim db As notesdatabase Set db = session.GetDatabase("",pnab) Dim doc As notesdocument Dim exvname As String Dim exshname As String exvname = "People" exshname = "Contacts" Dim view As notesview Set view= db.getview (exvname) Dim vcols As Variant Dim xlApp As Variant Dim xlsheet As Variant Set xlApp = CreateObject("Excel.Application") xlApp.Visible = True xlApp.Workbooks.Add xlApp.ReferenceStyle = 2 Set xlsheet = xlApp.Workbooks(1).Worksheets(1) xlsheet.Name = exshname Dim rows As Integer rows=1 Set doc = view.getfirstdocument rows = 2 xlsheet.Cells(1, 1).Value = "Salutation" xlsheet.Cells(1, 2).Value = "First Name" xlsheet.Cells(1, 3).Value = "Middle Initial" xlsheet.Cells(1, 4).Value = "Last Name" xlsheet.Cells(1, 5).Value = "Suffix" xlsheet.Cells(1, 6).Value = "Company Name" xlsheet.Cells(1, 7).Value = "Location" xlsheet.Cells(1, .Value = "Department" xlsheet.Cells(1, 9).Value = "Job Title" xlsheet.Cells(1, 10).Value = "Business Address" xlsheet.Cells(1,11).Value = "Office Zip" xlsheet.Cells(1, 12).Value = "Office Country" xlsheet.Cells(1, 13).Value = "Home Address" xlsheet.Cells(1, 14).Value = "Home Zip Code" xlsheet.Cells(1, 15).Value = "Home Country" xlsheet.Cells(1, 16).Value = "Office Phone Number" xlsheet.Cells(1, 17).Value = "Office Fax Phone Number" xlsheet.Cells(1, 18).Value = "Cell Phone Number" xlsheet.Cells(1, 19).Value = "Phone Number" xlsheet.Cells(1, 20).Value = "Home Fax Phone Number" xlsheet.Cells(1, 21).Value = "Pager" xlsheet.Cells(1, 22).Value = "EMail Address" xlsheet.Cells(1, 23).Value = "WebSite" xlsheet.Cells(1, 24).Value = "Birthday" xlsheet.Cells(1, 25).Value = "Spouse" xlsheet.Cells(1, 26).Value = "Children" xlsheet.Cells(1, 27).Value = "Assistant" xlsheet.Cells(1, 28).Value = "Manager" Do While Not (doc Is Nothing) xlsheet.Cells(rows, 1).Value = doc.Title(0) xlsheet.Cells(rows, 2).Value = doc.FirstName(0) xlsheet.Cells(rows, 3).Value = doc.MiddleInitial(0) xlsheet.Cells(rows, 4).Value = doc.LastName(0) xlsheet.Cells(rows, 5).Value = doc.Suffix(0) xlsheet.Cells(rows, 6).Value = doc.CompanyName(0) xlsheet.Cells(rows, 7).Value = doc.Location(0) xlsheet.Cells(rows, .Value = doc.Department(0) xlsheet.Cells(rows, 9).Value = doc.JobTitle(0) xlsheet.Cells(rows, 10).Value = doc.BusinessAddress(0) xlsheet.Cells(rows, 11).Value = doc.OfficeZip(0) xlsheet.Cells(rows, 12).Value = doc.OfficeCountry(0) xlsheet.Cells(rows, 13).Value = doc.HomeAddress(0) xlsheet.Cells(rows, 14).Value = doc.Zip(0) xlsheet.Cells(rows, 15).Value = doc.Country(0) xlsheet.Cells(rows, 16).Value = doc.OfficePhoneNumber(0) xlsheet.Cells(rows, 17).Value = doc.OfficeFaxPhoneNumber(0) xlsheet.Cells(rows, 18).Value = doc.CellPhoneNumber(0) xlsheet.Cells(rows, 19).Value = doc.PhoneNumber(0) xlsheet.Cells(rows, 20).Value = doc.HomeFaxPhoneNumber(0) xlsheet.Cells(rows, 21).Value = doc.PhoneNumber_6(0) xlsheet.Cells(rows, 22).Value = doc.MailAddress(0) xlsheet.Cells(rows, 23).Value = doc.WebSite(0) xlsheet.Cells(rows, 24).Value = doc.Birthday(0) xlsheet.Cells(rows, 25).Value = doc.Spouse(0) xlsheet.Cells(rows, 26).Value = doc.Children(0) xlsheet.Cells(rows, 27).Value = doc.Assistant(0) xlsheet.Cells(rows, 28).Value = doc.Manager(0) rows = rows+1 cols = 1 Set doc = view.getnextdocument(doc) Loop xlapp.range(xlsheet.cells(1,1), xlsheet.cells(rows, 28)).select xlapp.selection.columns.autofit End Sub'--Fin codeCes codes sont à mettre dans des agents.[%sig%]

[Stephane Maillard]

Bonjour,Précision : PNAB correspond à votre carnet d'arnet que vous voulez traiter.Exemple :Call exppnaboutlook("locnames.nsf") ' Mon carnet d'adresse local s'appel locnames.nsf[%sig%]