venerdì 22 maggio 2009

Un pulsante vale più di mille spiegazioni

Mi sono trovato più volte nella situazione di spiegare come esportare i contatti presenti nella rubrica di lotus notes in excel. Stanco di ripeterle ho googlato un po' ed ho creato un file di excel con bel un pulsante "Importa i contatti".
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