Nella prima riga ho inserito le intestazioni di colonna:
Title, LastName, FirstName, MiddleInitial, MailAddress, AltFullName, AltFullNameLanguage, PhoneNumber, CellPhoneNumber, HomeFAXPhoneNumber, HomeAddress, StreetAddress, City, JobTitle, OfficePhoneNumber, OfficeFAXPhoneNumber, CompanyName, OfficeStreetAddress , OfficeCity , OfficeState , OfficeZIP, State, AreaCodeFromLoc, Suffix, PhoneNumber_6, WebSite, BusinessAddress, Zip, OfficeCountry, country, Location, Spouse, Department, Children, Manager, Assistant, Birthday, FullName, Categories.
Ho creato poi una routine in vba come segue:
Sub Importa_Rubrica_Notes()
Dim DomDir As NotesDatabase
Dim DomContacts As NotesView
Dim DomDoc As NotesDocument
Dim StrName As String
Dim myRange As Range
Dim DomSession As NotesSession
Dim StrTestDomSession As String
Set DomSession = CreateObject("Lotus.NotesSession")
DomSession.Initialize
Set DomDir = DomSession.GetDatabase("", "names.nsf")
Set DomContacts = DomDir.GetView("Contatti")
Set DomDoc = DomContacts.GetFirstDocument
Dim tot As Integer
tot = 2
While Not (DomDoc Is Nothing)
Cells(tot, 1).Value = DomDoc.GetItemValue("Title")(0)
Cells(tot, 2).Value = DomDoc.GetItemValue("LastName")(0)
Cells(tot, 3).Value = DomDoc.GetItemValue("FirstName")(0)
Cells(tot, 4).Value = DomDoc.GetItemValue("MiddleInitial")(0)
Cells(tot, 5).Value = DomDoc.GetItemValue("MailAddress")(0)
Cells(tot, 6).Value = DomDoc.GetItemValue("AltFullName")(0)
Cells(tot, 7).Value = DomDoc.GetItemValue("AltFullNameLanguage")(0)
Cells(tot, 8).Value = DomDoc.GetItemValue("PhoneNumber")(0)
Cells(tot, 9).Value = DomDoc.GetItemValue("CellPhoneNumber")(0)
Cells(tot, 10).Value = DomDoc.GetItemValue("HomeFAXPhoneNumber")(0)
Cells(tot, 11).Value = DomDoc.GetItemValue("HomeAddress")(0)
Cells(tot, 12).Value = DomDoc.GetItemValue("StreetAddress")(0)
Cells(tot, 13).Value = DomDoc.GetItemValue("City")(0)
Cells(tot, 14).Value = DomDoc.GetItemValue("JobTitle")(0)
Cells(tot, 15).Value = DomDoc.GetItemValue("OfficePhoneNumber")(0)
Cells(tot, 16).Value = DomDoc.GetItemValue("OfficeFAXPhoneNumber")(0)
Cells(tot, 17).Value = DomDoc.GetItemValue("CompanyName")(0)
Cells(tot, 18).Value = DomDoc.GetItemValue("OfficeStreetAddress ")(0)
Cells(tot, 19).Value = DomDoc.GetItemValue("OfficeCity ")(0)
Cells(tot, 20).Value = DomDoc.GetItemValue("OfficeState ")(0)
Cells(tot, 21).Value = DomDoc.GetItemValue("OfficeZIP")(0)
Cells(tot, 22).Value = DomDoc.GetItemValue("State")(0)
Cells(tot, 23).Value = DomDoc.GetItemValue("AreaCodeFromLoc")(0)
Cells(tot, 24).Value = DomDoc.GetItemValue("Suffix")(0)
Cells(tot, 25).Value = DomDoc.GetItemValue("PhoneNumber_6")(0)
Cells(tot, 26).Value = DomDoc.GetItemValue("WebSite")(0)
Cells(tot, 27).Value = DomDoc.GetItemValue("BusinessAddress")(0)
Cells(tot, 28).Value = DomDoc.GetItemValue("Zip")(0)
Cells(tot, 29).Value = DomDoc.GetItemValue("OfficeCountry")(0)
Cells(tot, 30).Value = DomDoc.GetItemValue("country")(0)
Cells(tot, 31).Value = DomDoc.GetItemValue("Location")(0)
Cells(tot, 32).Value = DomDoc.GetItemValue("Spouse")(0)
Cells(tot, 33).Value = DomDoc.GetItemValue("Department")(0)
Cells(tot, 34).Value = DomDoc.GetItemValue("Children")(0)
Cells(tot, 35).Value = DomDoc.GetItemValue("Manager")(0)
Cells(tot, 36).Value = DomDoc.GetItemValue("Assistant")(0)
Cells(tot, 37).Value = DomDoc.GetItemValue("Birthday")(0)
Cells(tot, 38).Value = DomDoc.GetItemValue("FullName")(0)
Cells(tot, 39).Value = DomDoc.GetItemValue("Categories")(0)
Set DomDoc = DomContacts.GetNextDocument(DomDoc)
tot = tot + 1
Wend
End Sub
Ho collegato la funzione al pulsante, salvato e voilà:
adesso mi basta inviare il file a chi me lo chiede....
Nessun commento:
Posta un commento