DominoArea.org [Archive]

Bonjour,
Je souhaite réaliser l'extration de tous les documents d'une base afin d'en exploiter le contenu sous Excel.
L'idée etant d'avoir en 1ere ligne le nom des champs (1 par colonne), les lignes suivantes sont les data extraites des documents.

Constuire une vue dédiée avec tous les champs me semble difficile (beaucoup trop de champs dans le document + champs text riche).

Quelqu'un aurait'il sous le coude un script qui fonctionne que je pourrait implementer dans ma vue ?
Merci d'avance.

salut

regarde la dedans si tu ne trouve pas ton bonheur => http://forum.dominoarea.org/index.php?f=63

Salut Michael,
J'ai trouvé un post que tu a publié il y a pas mal de temps et dont le script qui semble repondre a ma problemetaique.
En rechanche, apres un copié collé de ce dernier dans un agent, je n'obtient aucun resultat, ni message d'erreur.
Tu as une idée ?



===> script
Function ExportGlobalDocumentXLS_V2(wCollection As notesDocumentCollection,Byval wft_nbNomChamp As Variant,Byval wft_nbChampSystem As Integer,Byval wft_nbLigne As Integer)

'cette function permet d'exporter tous tous les champs d'un document vers un fichier excel
'wNomchamp = true = insertion des nom des champs dans la premeire ligne
'wvrChampSystem = true = insertion des champs commençant par un "$"
'wvrLigne = true les document sont afficher 1 par ligne, false les document ssont affichés un par colonne

'Déclaration esVariables
Dim Doc As NotesDocument
Dim item As NotesITem

Dim lstChamp List As Integer
Dim lstChamp2 List As String
Dim lstChamp3 List As String

Dim nbIndicateur As Long
Dim nbDoc As Long
Dim I As Long
Dim J As Long
Dim K As Long
Dim L As Long
Dim nbChamp As Long
Dim nbLigne As Long
Dim nbColonneXLS As Long
Dim nbOngletXLS As Integer

Dim Mess As String
Dim OngletXLS As String
Dim PathFile As String
Dim Champ As String

Dim ft_nbAffiche As Integer
Dim ft_nbChamp_Sys As Integer
Dim ft_nbNomChamp As Integer
Dim ft_nbLigne As Integer
Dim objXLSApp As Variant
Dim objXLSWorkbooK As Variant
Dim objXLSWorkSheet As Variant

On Error Goto ErreurExportGlobalDocumentXLS_V2

If DB Is Nothing Or Session Is Nothing Then
Set Session = Nothing
Set DB = Nothing
Set Session = New NotesSession
Set DB = Session.CUrrentdatabase
End If

If wCollection Is Nothing Then
Msgbox "Il n'y a aucun document à exporter.",48," ATTENTION !"
Exit Function
Elseif wCOllection.count=0 Then
Msgbox "Il n'y a aucun document à exporter.",48," ATTENTION !"
Exit Function
End If

nbDoc = Clng(wCollection.count)
ft_nbChamp_Sys = wft_nbChampSystem
ft_nbNomChamp = wft_nbNomChamp
ft_nbLigne = wft_nbLigne

'la liste d'un champs pouvant varier d'un document à l'autre,
'la fonction commence par dresser la liste exhaustive de tous les champs pour tous les documents

Set Doc = wCollection.getFirstDocument
While Not Doc Is Nothing
Forall Value2 In Doc.Items
Champ = Ucase(Trim(Value2.name))
If ft_nbChamp_Sys = False Then
If Left(Trim(Champ),1) <> "$" Then
lstChamp2(Ucase(Trim(Champ))) = Ucase(Trim(Champ))
End If
Else
lstChamp2(Ucase(Trim(Champ))) = Ucase(Trim(Champ))
End If

Champ = ""
End Forall

Set Doc = wCollection.getNextDocument(Doc)
Wend

nbChamp = 0

'transfert dans les listes utilisés pour la génération
Forall Value In lstChamp2
nbChamp = nbChamp+1
lstChamp(Trim(Value)) = nbChamp
lstChamp3(nbChamp) = Trim(Value)
End Forall

Erase lstChamp2

If ft_nbLigne = True Then
If nbCHamp > 256 Then
Mess = "Il y a plus de 256 champs."+Chr(10)+"Il est impossible des les faire tenir sur le même onglet."+Chr(10)+"Désirez-vous transposer les lignes en colonnes ?"
If Msgbox (Mess,4+48+0," ATTENTION !")= 6 Then
ft_nbLigne = False
nbIndicateur = nbDoc
Else
nbIndicateur = nbCHamp
End If
Mess = ""
Else
nbIndicateur = nbCHamp
End If
Else
nbIndicateur = nbDoc
End If

ft_nbAffiche = True

'On récupère une instance Excel ouverte.
Set objXLSApp = Nothing
Set objXLSApp=createobject("Excel.Application")
objXLSApp.DisplayAlerts=False
objXLSApp.Visible= False 'vrAffiche

'On instancit un objet WorkBook Excel et on ouvre le fichier de mise a jour.
Set objXLSWorkbooK=objXLSApp.Workbooks.add

'On supprime toutes les onglets, sauf un
While objXLSWorkbooK.sheets.count>1
objXLSWorkbooK.sheets(2).select
objXLSWorkbooK.sheets(2).Delete
Wend

'un ongle peut contnir au maximum 256 colonne
's'il ya plus de 256 colonnes la fonction génére autant d'onglet que de multiple de 256

If nbIndicateur > 256 Then

i = nbIndicateur
nbOngletXLS = -1

While i > 0
nbOngletXLS = nbOngletXLS + 1
i = i - 256
Wend

For i=1 To nbOngletXLS
objXLSWorkbooK.sheets(i).select
objXLSWorkbooK.sheets.add
Next
For i = 1 To objXLSWorkbooK.sheets.count
OngletXLS = "EXPORT ONGLET N° "+Cstr(i)
objXLSWorkbooK.sheets(i).Name=Left(OngletXLS,31)
Next
Else
'On renomme la première.
OngletXLS = "EXPORT DU "+Format(Now,"dd-mm-yyyy")
objXLSWorkbooK.sheets(1).select
objXLSWorkbooK.sheets(1).Name=Left(OngletXLS,31)
End If


nbOngletXLS = objXLSWorkbooK.sheets.count

' On sélectionne la feuille de calcul qui nous intéresse.
objXLSWorkbooK.Sheets(1).Select
Set objXLSWorkSheet = objXLSApp.selection

If ft_nbNomChamp = True Then
'Insersion du nom des champs
If nbIndicateur <= 256 Then
If ft_nbLigne = True Then
'dans la permière ligne
For i = 1 To nbCHamp
objXLSWorkSheet.Cells(1,i).Value = Cstr(lstChamp3(i))
Next
nbLigne = 2
Else
'dans la permière colonne
For i = 1 To nbCHamp
objXLSWorkSheet.Cells(i,1).Value = Cstr(lstChamp3(i))
Next
nbLigne = 1
End If

Else
's'il ya plus de 256 champs la fonction passe automatiquement à l'onglet suivant
If ft_nbLigne = True Then
'explose la iste des champs sur la premiere ligne des différents onglet
J = 0
K = 1
For i = 1 To nbCHamp
J = J+1
If J > 256 Then
J = 1
K = K+1
objXLSWorkbooK.sheets(K).select
Set objXLSWorkSheet = objXLSApp.selection
End If
objXLSWorkSheet.Cells(1,J).Value = Cstr(lstChamp3(i))
Next
nbLigne = 2
Else
'insere la liste des champ sur la premeire colonne de chaque onglet
For i = 1 To nbOngletXLS
objXLSWorkbooK.sheets(i).select
Set objXLSWorkSheet = objXLSApp.selection
For J = 1 To nbCHamp
objXLSWorkSheet.Cells(J,1).Value = Cstr(lstChamp3(i))
Next
Next
nbLigne = 1
End If

End If

Else
nbLigne = 0
End If

Set Item = Nothing

Print ""
L = 0

'passe en revu chaque document à exporter
If nbIndicateur > 256 Then
'si plus de 256 champs
If ft_nbLigne = True Then
Set Doc = wCollection.getFirstDocument
While Not Doc Is Nothing
L = L+1
Print "Document : "+Cstr(L)+"/"+Cstr(nbDoc)
nbLigne = nbLigne +1
'1 document par ligne
objXLSWorkbooK.Sheets(1).Select
Set objXLSWorkSheet = objXLSApp.selection
J = 0
K = 1
For i = 1 To nbCHamp
J = J+1
Champ = Cstr(lstChamp3(i))
If ft_nbChamp_Sys = False Then
If Left(Trim(Champ),1) = "$" Then
Champ = ""
End If
End If
If Trim(CHamp)<>"" Then

If J > 256 Then
J = 1
K = K+1
objXLSWorkbooK.sheets(K).select
Set objXLSWorkSheet = objXLSApp.selection
End If
Set Item = Doc.getFirstItem(Champ)
If Not Item Is Nothing Then
objXLSWorkSheet.Cells(nbLigne,J).Value = Cstr(Item.text)
End If
End If
Next
Set Doc = wCollection.getNextDocument(Doc)
Wend
Else
'1 document par colonne

objXLSWorkbooK.Sheets(1).Select
Set objXLSWorkSheet = objXLSApp.selection
J = 1
Set Doc = wCollection.getFirstDocument
While Not Doc Is Nothing

L = L+1
Print "Document : "+Cstr(L)+"/"+Cstr(nbDoc)
nbLigne = nbLigne +1

If nbLigne > 256 Then
J = J+1
If ft_nbNomChamp = True Then
nbLigne = 1
Else
nbLigne = 2
End If
objXLSWorkbooK.Sheets(J).Select
Set objXLSWorkSheet = objXLSApp.selection
End If

For i = 1 To nbCHamp
Champ = Cstr(lstChamp3(i))
If ft_nbChamp_Sys = False Then
If Left(Trim(Champ),1) = "$" Then
Champ = ""
End If
End If

If Trim(CHamp)<>"" Then
Set Item = Doc.getFirstItem(Champ)
If Not Item Is Nothing Then
objXLSWorkSheet.Cells(J,nbLigne).Value = Cstr(Item.text)
End If
End If

Next
Set Doc = wCollection.getNextDocument(Doc)
Wend
End If
Else
Set Doc = wCollection.getFirstDocument
While Not Doc Is Nothing
L = L+1
Print "Document : "+Cstr(L)+"/"+Cstr(nbDoc)
nbLigne = nbLigne +1
'si moins de 256 colonnes
Forall Value2 In Doc.Items
Champ = Ucase(Trim(Value2.name))
If ft_nbChamp_Sys = False Then
If Left(Trim(Champ),1) = "$" Then
Champ = ""
End If
End If
If Trim(Champ) <> "" Then
Set Item = Doc.getFirstItem(Champ)

If Not Item Is Nothing Then
nbColonneXLS = lstChamp(Ucase(Trim(Champ)))
If ft_nbLigne = True Then
objXLSWorkSheet.Cells(nbLigne,nbColonneXLS).Value = Item.text
Else
'sil ya transpisition alors on inverse simplement la position des lignes et des colonnes
objXLSWorkSheet.Cells(nbColonneXLS,nbLigne).Value = Item.text
End If
End If
End If
Set Item = Nothing
Champ = ""
End Forall
Set Doc = wCollection.getNextDocument(Doc)
Wend
End If

L = 0
Print ""
Erase lstChamp3
Erase lstChamp

For i = 1 To nbOngletXLS

objXLSWorkbooK.sheets(i).select
Set objXLSWorkSheet = objXLSApp.selection

'mise en page de la feuille
objXLSApp.Cells.Select
' objXLSApp.Range(objXLSWorkSheet.Cells(1,1), objXLSWorkSheet.Cells(nbLigne,nbColonneXLS)).Select
objXLSApp.Selection.Font.Name = "Arial"
objXLSApp.Selection.Font.Size = 9

If ft_nbLigne = True Then
objXLSApp.Selection.Columns.AutoFit
End If

With objXLSApp.Worksheets(i)
' .PageSetup.Orientation = 1
.PageSetup.centerheader = "Export du "+Format(Now,"DD-MM-YYYY à HH:NN:SS")
.Pagesetup.RightFooter = "Page &P" & Chr$(13) '+ "Date : &D"
.Pagesetup.CenterFooter = ""
End With
objXLSApp.ReferenceStyle = 1

If ft_nbNomChamp = True Then
' mise en page des titres des colonnes
If ft_nbLigne = True Then
objXLSApp.Rows("1:1").Select
Else
objXLSApp.Columns("A:A").Select
End If
objXLSApp.Selection.Font.Bold = True
objXLSApp.Selection.Font.Underline = True
End If

objXLSApp.Range("A1").Select
Next

objXLSWorkbooK.Sheets(1).Select
Set objXLSWorkSheet = objXLSApp.selection
objXLSApp.Range("A1").Select

If ft_nbAffiche = False Then

'ferme et enregistre le fichier excel
objXLSApp.Visible=False
objXLSApp.ActiveWorkbook.saveas PathFile ' Sauve le document
objXLSApp.ActiveWorkBook.close
objXLSApp.quit

Select Case Trim(Cstr(nbDoc))
Case ""
Mess = "Zéro document exporté."
Case "0"
Mess = "Zéro document exporté."
Case "1"
Mess = "Un document exporté."
Case Else
Mess = Cstr(nbDoc) +" documents ont été exportés."
End Select
Msgbox Mess,64,"FIN D'EXPORTATION"
Else
objXLSApp.Visible= ft_nbAffiche

End If

Set objXLSApp=Nothing
Set objXLSWorkbooK= Nothing
Set objXLSWorkSheet = Nothing

Exit Function
ErreurExportGlobalDocumentXLS_V2:
Erase lstChamp
Erase lstChamp2
Erase lstChamp3
Set objXLSApp=Nothing
Set objXLSWorkbooK= Nothing
Set objXLSWorkSheet = Nothing
Msgbox "il y a eu un problème lors de l'exportation vers excel."+Chr(10)+"Exportation annulée."+Chr(10)+"Module : ExportGlobalDocumentXLS_V2 : "+Cstr(Err),16,"ATTENTION !"
Exit Function

End Function

euh non !

ça donne quoi avec le debugeur ?

bonjour

il s'agit d'une fonction
je suppose que dans ton agent tu l'as appellé dans l'initialize, avec les bons arguments ?
en cas d'erreur, il devrait y avoir des message box

Certainement moins étreignant que du code :
http://www.openntf.org/projects/pmt.nsf ... 20Facility

A vrai dire roubech, j'ai fait un gros copié collé dans un agent ... sans aucun autre apport personnel .... j'en suis presque honteux.
D'ailleurs comme un bon bourin, je ne sait quelle modif apporter.

Merci Dominux, je vais jeter un coup d'ail sur openntf !

Wow !!! impresionnant ce petit outil Dominux ...
La prise en main est super simple et le resultat a l'air redoutable
Merci encore !