gros probleme d'exportation....

[loulou]

bonjour tout le monde,Je dois exporter des colonnes de notes sous excel en relevant d'abord le noms des colonnes de Excel puis les comparer a celles existantes sous Notes pour enfin n'exporter que les donnees correspondantes aux colonnes existantes sous excel....voila le code que j'ai fait (avec l'aide de votre forum en partie...)est ce que qqun pourrait me dire quelles modifications je dois faire pour parvenir a obtenir ce que je veux.... et puis je n'ai pas fait la partie comparaison des noms de colonnes récupérees sous Notes avec celles existantes sous Notes, je n'ai pas su le faire en fait! Sub Initialize Dim Session As New NotesSession Dim db As NotesDatabase Dim xlsObject As Variant Dim xlsWorkBook As Variant Dim xlsSheet As Variant Dim tableau() As String Dim maxcols As Integer Dim tCol() As String Dim dataview As NotesView Dim IndLigne As Integer ' indice de parcours des lignes Dim IndCol As Integer ' indice de parcours des colonnes Dim collection As NotesDocumentCollection ' Dim Columns As notesViewColumnArray Set db = session.CurrentDatabase ' Set dataview = db.getview(view.Name) ' Set dataview = db.getview(ViewString) ' Ouvre la vue Set xlsObject = CreateObject( "Excel.Application" ) ' Ouverture du fichier. En retour, on récupère le classeur Set xlsWorkBook = OpenXlsFile ("C:\layou.xls", xlsObject) xlsObject.Visible = False ' Récupération de la feuille data Set xlsSheet = xlsWorkbook.Worksheets("data") ' Récupération du titre de mes colonnes existantes sous excel ' avec utilisation d'un boucle while' Récupération du nbre de colonnes de la vue en question maxcols = Ubound (view.Columns) + 1' Redimensionnement du tableau Redim tCol(maxcols) As String Dim i As Integer Dim sMsg As String For i = 0 To maxcols tCol(i) = xlsSheet.Cells(1,i+1).Value Next i For i = 0 To maxcols sMsg = sMsg + "Col" + Cstr(i+1) + " : " + tCol(i) + " " Next i Msgbox sMsg ' nombre total de colonnes de la vue maxcols = Ubound (view.Columns) + 1' Redimensionnement du tableau Redim tCol2(maxcols) As String Dim Indice As Integer Dim sMsg2 As String ' recupération du noms des colonnes du fichier excel For Indice = 0 To maxcols tCol2(Indice) = xlsSheet.Cells(1,Indice+1).Value Next Indice 'affichage d'un message de confirmation avec les différentes colonnes relevées. For Indice = 0 To maxcols sMsg2 = sMsg2 + "Col" + Cstr(Indice+1) + " : " + tCol2(Indice) + " " Next Indice Msgbox sMsg2'appel de la procedure permettant l'export des colonnes selectionnées précédemment! Call ExtractNotesToExcel(Lview, TabCol) ' Fermeture du classeur excel xlsWorkbook.Close False xlsObject.Quit 'appel de la procedure permettant l'export des colonnes selectionnées précédemment! Call ExtractNotesToExcel(Lview, TabCol) End SubFunction OpenXlsFile (Path As String, xlsObject As Variant) As Variant xlsObject.Workbooks.Open Path Set OpenXlsFile = xlsObject.ActiveWorkbookEnd FunctionSub ExtractNotesToExcel (Vue, TabCol As Variant) Dim Doc As notesdocument Dim Valeur As Variant Dim xlApp As Variant Dim Ligne As Integer Dim Colonne As Integer Dim IndiceTab As Integer Set Doc = Vue.getfirstdocument If Not Doc Is Nothing Then' Création de l'objet Excel Set xlApp = createObject("Excel.sheet")' Création du classeur Excel xlApp.Application.Workbooks.add' Création d'une page avec renommage xlApp.Application.Sheets.add xlApp.Application.Sheets(xlApp.Application.activesheet.name).Name = "Exportation vue Notes" End If Ligne = 1 While Not Doc Is Nothing Colonne = 1 For IndiceTab = 0 To Ubound(TabCol) Valeur = Doc.ColumnValues(Val(TabCol(IndiceTab))) xlApp.Application.activesheet.Cells(Ligne,Colonne).Value = Valeur Colonne = Colonne + 1 Next ' Passage au doc suivant Set Doc = Vue.getnextdocument(Doc) Ligne = Ligne + 1 Wend ' On rend le classeur Excel visible xlApp.application.visible= True ' Enregistrement du doc xlApp.Application.activesheet.SaveAs "C:\Temp\Classeur2.xls"End Subj'attends vos réponses... elles me sont d'une précieuse aide!Merci par avance!Lorine

[lucie]

Est ce que ce sera toujours les mêmes colonnes que tu exporteras de notes vers excel ?Tes colonnes dans excel ont-elles toujours le même ordre ?En fait je ne pense pas que tu puisses travailler avec le nom des colonnes, du moins sous notes le nom de colonne n'est pas la référence c'est le nom du champ qui l'est..

[loulou]

Bonjour Lucie,je vais tenter de répondre a toutes les questions:tout d'abord, je ne vais pas toujours exporter les memes colonnes de notes vers excel, ca dépend des colonnes dont on a besoin dans le fichier excel.... Le programme doit lire le nom de ces colonnes (sous excel) et il doit prendre les colonnes de meme noms existantes sous Notes.Ensuite, les colonnes sous excel ne sont pas toujours dans le meme ordre... On doit pouvoir changer l'ordre, ou ajouter une colonne, ou en supprimer une sans que cela ne change rien au niveau du programme....je ne sais pas si j'ai été assez claire, mais je l'espere qd meme.J'attend une réponse....Merci de m'aiderLorine

[lucie]

C'est bon j'ai compris. )Je suis désolée mais je ne peux t'aider, j'avais un agent pour exporter vers excel mais c'était toujours les mêmes colonnes, donc je ne travaillais pas sur le nom des colonnes. (

[loulou]

c pas graveMerci qd meme

[lucie]

Je te maille un code que tu pourras peut-être adapter )

[loulou]

ok, merci c gentil )

[lucie]

bon changement de programme, mon serveur (et surtout la sécurité) ne veut pas envoyer vers hotmail (j'aurais dû m'en douter) donc je te poste le tout ici...c'est un peu long ) j'ai un agent d'importation d'excel vers notes, et il fait une comparaison sur la valeur d'une colonne, tu pourras peut-être l'adapter pour que ça fonctionne dans l'autre sens.Si tu as besoin d'un complément d'explications, n'hesites pas. Déclarations : Dim xlFilename As String Dim db As NotesDatabase Dim view As NotesView Dim doc As NotesDocument Dim row As Integer Dim Excel As Variant Dim xlWorkbook As Variant Dim xlSheet As Variant Dim chercheSociete As NotesDocumentCollection Dim docTrouveSociete As NotesDocument Dim valeur As Variant Dim valNom As Variant Dim valPrenom As Variant Dim Continue As Variant Initialize : Sub Initialize %REM lucie 24/10/2002 Agent permettant la mise à jour des informations contenues dans D:\Marketing\Contact.xls et les envoi vers la vue (VFicheContact) %END REM On Error Goto erreur xlFilename = "D:\Marketing\Contact.xls" '// chemin du dossier excel devant être importé Dim session As New NotesSession Set db = session.CurrentDatabase Set view = db.GetView("(VFicheContact)") '// vue dans laquelle on importe Set Excel = CreateObject( "excel.application" ) Excel.Visible = False ' empeche l'ouverture de la fenetre Excel Excel.Workbooks.Open xlFilename Set xlWorkbook = Excel.ActiveWorkbook Set xlSheet = xlWorkbook.ActiveSheet '// Cycle through the rows of the Excel file, pulling the data over to Notes Continue=True row=1 While Continue Set valeur = xlSheet.Cells( row, 16 ) ' Prend la colonne correspondante à Société ds excel If Trim(Cstr(valeur.value))="" Then ' Si plus de valeur, alors Fin Continue=False Else Set valNom = xlSheet.Cells( row, 2 ) Set valPrenom = xlSheet.Cells( row, 3 ) ' Met en minuscule et concatene les valeurs de Société+Nom+Prenom ds excel contact = Lcase(Cstr(valeur.value) & Cstr(valNom.value) & Cstr(valPrenom.value)) ' Recherche les valeurs exactes communes entre SocieteXL et la vue et fait une collection Set docTrouveSociete = view.GetDocumentByKey (contact, False ) If docTrouveSociete Is Nothing Then Call Creation() Else Call MiseAJour (docTrouveSociete) End If End If ' pour Cstr(valeur.value) row=row+1 Wend Excel.Quit '// ferme Excel Set Excel = Nothing '// Free the memory that we'd used Print " " '//Clear the status line Exit Sub erreur: If Not (Excel Is Nothing) Then Excel.Quit '// ferme Excel Set Excel = Nothing '// Free the memory that we'd used Print " " '//Clear the status line End If Print Error$ Close Exit Sub End Sub Creation : Sub Creation With xlSheet Set doc = db.CreateDocument '// Create a new doc doc.Form = "ContactsEntreprise" '// masque de référence doc.Civilité=.Cells( row, 1 ).Value doc.NomContact=.Cells( row, 2 ).Value doc.Prenom=.Cells( row, 3 ).Value doc.Fonction=.Cells( row, 4 ).Value doc.FonctionDet=.Cells( row, 5 ).Value doc.Service=.Cells( row, 6 ).Value doc.NumeTelBureau=.Cells( row, 7 ).Value doc.NumeTelStand=.Cells( row, 8 ).Value doc.NumeTelPortable=.Cells( row, 9 ).Value doc.NumeTelAutre=.Cells( row, 10 ).Value doc.Source=.Cells( row, 11 ).Value doc.EmailContact=.Cells( row, 12 ).Value doc.FaxContact=.Cells( row,13).Value doc.Hobbies=.Cells(row,14).Value doc.AutreQualif=.Cells( row,15).Value doc.Societe=.Cells( row,16).Value doc.AdresseSociete=.Cells( row,17).Value doc.AdresseSoc=.Cells( row,18).Value doc.CPSociete=.Cells( row,19).Value doc.VilleSociete=.Cells( row,20).Value doc.Region=.Cells( row,21).Value doc.PaysSociete=.Cells( row,22).Value doc.SiteWeb=.Cells( row,23).Value doc.Secteur=.Cells( row,24).Value doc.Autresource=.Cells( row,25).Value doc.CreatCt=.Cells( row,26).Value doc.DateCreation=.Cells( row,27).Value doc.Modif=.Cells( row,28).Value doc.Motifs=.Cells( row,29).Value Call doc.Save( True, True ) '// Save the new doc End With End Sub MiseAJour : Sub MiseAJour (docmaj As notesdocument) With xlSheet Dim item As NotesItem Set item = docmaj.ReplaceItemValue( "Societe",.Cells( row,16).Value ) Set item = docmaj .ReplaceItemValue( "NomContact",.Cells( row, 2 ).Value ) Set item = docmaj.ReplaceItemValue( "Prenom",.Cells( row, 3 ).Value) Set item = docmaj .ReplaceItemValue( "civilité",.Cells( row, 1 ).Value ) Set item = docmaj.ReplaceItemValue( "Fonction",.Cells( row, 4 ).Value) Set item = docmaj.ReplaceItemValue( "FonctionDet",.Cells( row, 5 ).Value) Set item = docmaj.ReplaceItemValue( "Service",.Cells( row, 6 ).Value) Set item = docmaj.ReplaceItemValue( "NumeTelBureau",.Cells( row, 7 ).Value) Set item = docmaj.ReplaceItemValue( "NumeTelStand",.Cells( row, 8 ).Value) Set item = docmaj.ReplaceItemValue( "NumeTelPortable",.Cells( row, 9 ).Value) Set item = docmaj.ReplaceItemValue( "NumeTelAutre",.Cells( row, 10 ).Value) Set item = docmaj.ReplaceItemValue( "Source",.Cells( row,11).Value) Set item = docmaj.ReplaceItemValue( "EmailContact",.Cells( row, 12 ).Value) Set item = docmaj.ReplaceItemValue( "FaxContact",.Cells( row,13).Value) Set item = docmaj.ReplaceItemValue( "Hobbies",.Cells( row,14).Value ) Set item = docmaj.ReplaceItemValue( "AutreQualif",.Cells( row,15).Value ) Set item = docmaj.ReplaceItemValue( "AdresseSociete",.Cells( row,17).Value) Set item = docmaj.ReplaceItemValue( "AdresseSoc",.Cells( row,18).Value) Set item = docmaj.ReplaceItemValue( "CPSociete",.Cells( row,19).Value) Set item = docmaj.ReplaceItemValue( "VilleSociete",.Cells( row,20).Value) Set item = docmaj.ReplaceItemValue( "Region",.Cells( row,21).Value ) Set item = docmaj.ReplaceItemValue( "PaysSociete",.Cells( row,22).Value) Set item = docmaj.ReplaceItemValue( "SiteWeb",.Cells( row,23).Value) Set item = docmaj.ReplaceItemValue( "Secteur",.Cells( row,24).Value) Set item = docmaj.ReplaceItemValue( "Autresource",.Cells( row,25).Value ) Set item = docmaj.ReplaceItemValue( "CreatCt",.Cells( row,26).Value ) Set item = docmaj.ReplaceItemValue( "DateCreation",.Cells( row,27).Value ) Set item = docmaj.ReplaceItemValue( "Modif",.Cells( row,28).Value ) Set item = docmaj.ReplaceItemValue( "Motifs",.Cells( row,29).Value ) Call docmaj.Save( True, True ) End With End Sub