DominoArea.org [Archive]

Comment récupérer le contenu d'une vue aprés avoir mis en oeuvre une recherche.J'ai une vue, j'effectue une recherche le résultat s'affiche, je voudrai récupérer ce résultat dans un obje vue et le passer dans excel.La partie excel ca colle ce qui me manque c'est la récupération de la vue courante.

Bonjour,Je ne comprend pas trop le problème. Si avant l'exportation vous faîtes un FTSearch sur la vue que vous souhaitez exporté normalement il n'y aura que les documents trouvé qui devrait être envoyé sur Excel.[%sig%]

Bonjour,Voici un code qui recherche des documents et les envoie dans un folder, après il ne suffit plus que de lancer le programme d'exportation Excel pour n'avoir que les données voulues :Créer un dossier 'test' par exemple.Dans un agent :Sub initialise dim s as new notessession dim db as notesdatabase set db = s.currentdatabase rc = LimitlessFTSearch("FIELD form=NomMasque", "test", db.FilePath) messagebox rcEnd SubAppel de la fonction :Query => Ce que vous voulez rechercherFolder => Le dossier ou vous voulez mettre les documents trouvédbpath => Le chemin d'accès à la base NotesDans le code vous avez la méthode pour ouvrir, fermer et traiter les erreurs API Notes.Attention : Plateforme Win32 uniquemenDans une bibliothèque de scriptOption PublicConst FT_SEARCH_SET_COLL = &H00000001Const FT_SEARCH_NUMDOCS_ONLY = &H00000002Const FT_SEARCH_REFINE = &H00000004Const FT_SEARCH_SCORES = &H00000008Const FT_SEARCH_RET_IDTABLE = &H00000010Const FT_SEARCH_SORT_DATE = &H00000020Const FT_SEARCH_SORT_ASCEND = &H00000040Const FT_SEARCH_TOP_SCORES = &H00000080Const FT_SEARCH_STEM_WORDS = &H00000200Const FT_SEARCH_THESAURUS_WORDS = &H00000400Const FT_SEARCH_EXT_RET_URL = &H00004000Const FT_SEARCH_EXT_DOMAIN = &H00020000Const FT_SEARCH_FUZZY = &H00080000Const DFLAGPAT_FOLDER$ = "(+-04n*F"Const DFLAGPAT_VIEWS_AND_FOLDERS$ = "-G40n"Const NOTE_CLASS_VIEW% = &H0008Const PKG_MISC% = &H0400Const ERR_NOT_FOUND = PKG_MISC + 4Const UPDATE_FORCE% = &H0001Dim batchSize As IntegerDim queryStr As StringDim dbHandle As LongDim status As IntegerDim searchHandle As LongDim searchOptions As LongDim retNumHits As LongDim numDocs As LongDim resultHandle As LongDim folderID As LongDim updateOptions As IntegerDim junkLong As LongDim junkBoolean As IntegerDim dbOpenFlag As IntegerDim searchHandleOpenFlag As IntegerDim searchResultsLockedFlag As IntegerDim folderNoteOpenFlag As IntegerDeclare Function apiDbOpen Lib "nnotes.dll" Alias "NSFDbOpen" (Byval PathName As String, rethDb As Long) As IntegerDeclare Function apiDbClose Lib "nnotes.dll" Alias "NSFDbClose" (Byval hDB As Long) As IntegerDeclare Function apiGetDBID Lib "nnotes.dll" Alias "NSFDbGetOpenDatabaseID" (Byval hDBU As Long) As LongDeclare Function apiFTOpenSearch Lib "nnotes.dll" Alias "FTOpenSearch" (rethSearch As Long) As IntegerDeclare Function apiFTCloseSearch Lib "nnotes.dll" Alias "FTCloseSearch" (Byval hSearch As Long) As IntegerDeclare Function apiFTSearch Lib "nnotes.dll" Alias "FTSearch" (Byval hDB As Long, phSearch As Long, Byval hColl As Integer, Byval query As String, Byval options As Long, Byval limit As Integer, Byval hlDTable As Integer, retNumDocs As Long, reserved As Long, rethResults As Long) As IntegerDeclare Function apiFTSearchExt Lib "nnotes.dll" Alias "FTSearchExt" (Byval hDB As Long, phSearch As Long, Byval hColl As Integer, Byval query As String, Byval options As Long, Byval limit As Integer, Byval hlDTable As Long, retNumDocs As Long, reserved As Long, rethResults As Long, retNumHits As Long, Byval Start As Long, Byval Count As Integer, Byval Arg As Integer, Byval hNames As Long) As IntegerDeclare Function apiIDEntries Lib "nnotes.dll" Alias "IDEntries" (Byval hTable As Long) As LongDeclare Function apiIDScan Lib "nnotes.dll" Alias "IDScan" (Byval hTable As Long, Byval fFirst As Integer, retID As Long) As IntegerDeclare Function apiIDDestroyTable Lib "nnotes.dll" Alias "IDDestroyTable" (Byval hTable As Long) As IntegerDeclare Function apiNIFFindDesignNoteExt Lib "nnotes.dll" Alias "NIFFindDesignNoteExt" (Byval hFile As Long, Byval noteName As String, Byval noteClass As Integer, Byval pszFlagsPattern As String, retNoteID As Long, Byval Options As Long) As IntegerDeclare Function apiNSFNoteUpdate Lib "nnotes.dll" Alias "NSFNoteUpdate" (Byval noteHandle As Long, Byval updateFlags As Integer) As IntegerDeclare Function apiNSFNoteClose Lib "nnotes.dll" Alias "NSFNoteClose" (Byval noteHandle As Long) As IntegerDeclare Function apiFolderDocAdd Lib "nnotes.dll" Alias "FolderDocAdd" (Byval hDataDB As Long, Byval hFolderDB As Long, Byval FolderNoteID As Long, Byval hTable As Long, Byval dwFlags As Long) As IntegerDeclare Function apiOSLoadString Lib "nnotes.dll" Alias "OSLoadString" (Byval hModule As Long, Byval StringCode As Integer, Byval retBuffer As String, Byval BufferLength As Integer) As IntegerDeclare Function apiOSLockObject Lib "nnotes.dll" Alias "OSLockObject" (Byval handle As Long) As LongDeclare Function apiOSUnLockObject Lib "nnotes.dll" Alias "OSUnlockObject" (Byval handle As Long) As IntegerFunction LimitlessFTSearch (Byval query As String, Byval destinationFolderName As String, Byval dbPath As String) As String LimitlessFTSearch = "" queryStr = query status = apiDbOpen(dbPath, DBHandle) If (status <> 0) Then LimitlessFTSearch = "apiDbOpen(): " + apiError(status) LimitlessFTSearch = LimitlessFTSearch + CleanUp() Exit Function Else dbOpenFlag = 1 End If status = apiFTOpenSearch(SearchHandle) If (status <> 0) Then LimitlessFTSearch = "apiFTOpenSearch(): " + apiError(status) LimitlessFTSearch = LimitlessFTSearch + CleanUp() Exit Function Else searchHandleOpenFlag = 1 End If status = apiNIFFindView(dbHandle, destinationFolderName, folderID) If (status <> 0) Then ' If (status = ERR_NOT_FOUND) Then' LimitlessFTSearch = {The folder named "} + destinationFolderName + {" doesn't exist. Cleaning up and exiting."}' End If LimitlessFTSearch = "apiNIFFindView(): " + apiError(status) LimitlessFTSearch = LimitlessFTSearch + CleanUp() Exit Function Else folderNoteOpenFlag = 1 End If Dim currentDocPointer As Long currentDocPointer = 0 retNumHits = 1 While (currentDocPointer <= retNumHits) status = RunSearch (currentDocPointer, batchSize) If (status <> 0) Then LimitlessFTSearch = "RunSearch(): apiFTSearchExt(): " + apiError(status) LimitlessFTSearch = LimitlessFTSearch + CleanUp() Exit Function End If %REM Print "............................................and the number of docs returned is...(actual)........... :" + Cstr(numDocs) Print "............................................and the number of total hits returned is..(poss)......... :" + Cstr(retNumHits)%END REM If (retNumHits <> 0) Then junkLong = apiOSLockObject(resultHandle) status = apiFolderDocAdd(dbHandle, 0, folderID, resultHandle, 0) If (status <> 0) Then LimitlessFTSearch = "apiFolderDocAdd(): " + apiError(status) LimitlessFTSearch = LimitlessFTSearch + CleanUpIDTable() LimitlessFTSearch = LimitlessFTSearch + CleanUp() Exit Function End If %REM numEntries& = apiIDEntries(resultHandle) Print "The table we have a handle on has this many entries : " + Cstr(numEntries&) boolean% = apiIDScan(resultHandle, 1, noteID&) While (boolean% = 1) Print "NoteID: " +Cstr(noteID&) boolean% = apiIDScan(resultHandle, 0, noteID&) Wend%END REM LimitlessFTSearch = LimitlessFTSearch + CleanUpIDTable() End If currentDocPointer = currentDocPointer + batchSize Wend LimitlessFTSearch = LimitlessFTSearch + CleanUp() End FunctionFunction CleanUp() As String CleanUp = "" If (searchHandleOpenFlag = 1) Then status = apiFTCloseSearch(SearchHandle) If (status <> 0) Then CleanUp = CleanUp + " - apiFTCloseSearch(): " + apiError(status) End If ' saveFolderNoteFlag = 1 ' If (saveFolderNoteFlag = 1) Then' updateOptions = UPDATE_FORCE' status = apiNSFNoteUpdate(folderID, updateOptions)' If (status <> 0) Then CleanUp = CleanUp + " - apiNSFNoteUpdate(): " + apiError(status)' End If ' If (folderNoteOpenFlag = 1) Then' status = apiNSFNoteClose(folderID)' End If 'Close the database, if needed. If (dbOpenFlag = 1) Then status = apiDbClose(DBHandle) If (status <> 0) Then CleanUp = CleanUp + " - apiDbClose(): " + apiError(status) End IfEnd FunctionFunction apiError (status As Integer) As String Dim Err_Mask As Integer Dim errorStr As String Err_Mask = &H00003fff status = status And Err_Mask errorStr = "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx" status = apiOSLoadString(0, status, errorStr , Len(errorStr) - 1) apiError = "apiError(): " + errorStrEnd FunctionFunction apiNIFFindView(Byval hFile As Long, Byval viewName As String, retNoteID As Long) As Integer apiNIFFindView = apiNIFFindDesignNoteExt(hFile, viewName, NOTE_CLASS_VIEW, DFLAGPAT_VIEWS_AND_FOLDERS, retNoteID, 0) End FunctionFunction RunSearch (Byval start As Long, Byval count As Integer) As Integer Dim collectionHandle As Integer Dim limit As Integer Dim idTableHandle As Long Dim reserved As Long Dim arg As Integer Dim namesHandle As Long collectionHandle = 0 limit = 0 idTableHandle = 0 reserved = 0 arg = 0 namesHandle = 0 searchOptions = FT_SEARCH_RET_IDTABLE RunSearch = apiFTSearchExt(dbHandle, searchHandle, collectionHandle, queryStr, searchOptions, limit, idTableHandle, numDocs, 0, resultHandle, retNumHits, start, count, arg, 0) End FunctionSub Initialize batchSize = 4900 dbOpenFlag = 0 searchHandleOpenFlag = 0 searchResultsLockedFlag = 0 folderNoteOpenFlag = 0 End SubFunction CleanUpIDTable() As String CleanUpIDTable = "" junkBoolean = apiOSUnlockObject(resultHandle) status = apiIDDestroyTable(resultHandle) If (status <> 0) Then CleanUpIDTable = CleanUpIDTable + " - apiIDDestroyTable(): " + apiError(status) CleanUpIDTable = CleanUpIDTable + CleanUp() Exit Function End IfEnd Function[%sig%]

Re,Désoler, je n'est pas eu le temps d'épurer le code suite à des tests que j'ai pratiqué.[%sig%]

Merci,mais là c'est trop fort pour moi,je ne sais pas si je vais comprendre.Quand tu lances l'action dans quelle situation es tu par rapport à lotus?dans une vue en cours avec les documents sélectionnés suite à l'emploi du module recherche.....?Je plane humblement.J'essaierai de tester ce WE....

Merci à tous ceux qui contribuent ou ont contribué e Sandbox à www.yel.ch j'ai déniché un code prêt à l'emploi . Une perle'Export to Excel v2.05: Option Public%REM================================================================================Export-Script================================================================================This Script has been created by D. Hasa, Yel GmbH, Switzerland in April 2001It may be distributed and modified freely, as long as this header is kept intact.Please report any bugs, fixes or enhancements to d.h@yel.chThis script exports a UIView 'As-Is' from Notes 5 to Excel 2000It has been tested with Notes 5.03/5.05 into Excel97 & 2000--> every column (include headers) is a column in Excel and every value displayed of a document is a row in ExcelEvery Value will be inserted as Text into Excel================================================================================Implementation================================================================================It is only a script without any Dialog-Boxes by exception --> Distribution and Implementation is very easySimply copy this whole file into an Agent:Name: Export to ExcelRun: Manually from Actions Menuact on: All documents in ViewRun: Lotus Script--> Export works in any View/Folder of that database================================================================================Updates:================================================================================30.11.01SELECTED DOCUMENTSYou can now export also only selected documents, but the script gets thru all documents in a view, because the the property doc.ColumnValues(n) only returns a value, if it has been fetched from a view (selected documents get fetched by a NotesDocumentCollection).----Excel-Object ProblemsAdded another ExcelApp-Constant (Excel.Application.----Visualised ProgressThis script is From http://www.notes.net/50beta.nsf/7d6a878 ... mentThanks to Les Szklanny--> I cannot give you any guaranty of proper functionality you can turn it on or of --> const visualproc================================================================================14.01.02================================================================================Changed Error-Handling on ExcelObject Create================================================================================09.03.02================================================================================- Removed Form1..4 from Formatting (does not exist anymore)- Added Constant for Papersize- If titbar-rotate = 0 then autofit from line 1 else from line 2================================================================================02.07.02================================================================================- Removed Error with 'count'-columns30.07.02- Changed bug if only one doc is selected (Thanks to A. Migliore)================================================================================14.12.02================================================================================- Added ability to export multivalue columns (Functions ListText and ReplaceSubString)================================================================================%ENDREM'Set Papersize: 10*14=16 / 11*17=17 / A3=8 / A4=9 / A4small=10 / A5=11 / B4=12 / B5=13Const psize = 9 Const visualproc = True 'Display VisualProgress true = yes /false = noConst AppConst = "Excel.Application"Const AppConst2 = "Excel.Application.8"Const NPB_TWOLINE% = 1 '1 is for the big "in its window" progress bar and 32 is for the small blue line at the bottom of the screen' Procedures in nnotesws.dll (undocumented!!).Dim db As NotesDatabaseDim view As NotesViewDim doc As NotesDocumentDim nc, nl, nmoreDim selList(0 To 16) As StringDim vcol List As StringDim excelAppObject As VariantDeclare Function NEMProgressBegin Lib "nnotesws.dll" ( Byval wFlags As Integer ) As LongDeclare Sub NEMProgressEnd Lib "nnotesws.dll" ( Byval hwnd As Long )Declare Sub NEMProgressSetBarPos Lib "nnotesws.dll" ( Byval hwnd As Long, Byval dwPos As Long)Declare Sub NEMProgressSetBarRange Lib "nnotesws.dll" ( Byval hwnd As Long, Byval dwMax As Long )Declare Sub NEMProgressSetText Lib "nnotesws.dll" ( Byval hwnd As Long, Byval pcszLine1 As String, _Byval pcszLine2 As String )Class ProgressBar' Objects Private hwnd As Long ' Constructor. Sub New (BarRange As Long) On Error Goto ErrorHandler ' Create the progress bar. Me.hwnd = NEMProgressBegin (NPB_TWOLINE) ' Set the bar range. Call NEMProgressSetBarRange (Me.hwnd, BarRange) Exit Sub ErrorHandler: Dim TheError As String TheError = "Constructor: Error " + Str(Err) + ": " + Error$ Messagebox TheError, 0 + 48, "Progress Bar Error" End Sub ' Destructor. Sub Delete' Destroy the progress bar. Call NEMProgressEnd (Me.hwnd) End Sub Public Sub UpdatePosition (BarPos As Long)' Update the bar position. Call NEMProgressSetBarPos (Me.hwnd, BarPos) End Sub Public Sub UpdateProgressText (BarMsg As String, UpdateMsg As String)' Update progress text. Call NEMProgressSetText (Me.hwnd, BarMsg, UpdateMsg) End Sub End ClassSub Initialize On Error Goto ExitExcel'Main Code Dim session As New NotesSession Dim workspace As New NotesUIWorkspace Dim UIview As NotesUIView Dim collection As NotesDocumentCollection Dim coldoc As NotesDocument Dim BarMsg As String, UpdateMsg As String Dim countall As Long, countthis As Long, countallsel As Long, countthissel As Long Dim NChar As String Set UIview = workspace.CurrentView Set db = session.CurrentDatabase UIViewname = UIView.ViewName UIViewAlias = UIView.Viewalias Set view = db.GetView( UIViewName ) Set collection = db.UnprocessedDocuments gowithselection = False goonall = True 'Determine if it is a collection countallsel = collection.count If countallsel >=1 Then gowithselection = workspace.Prompt(PROMPT_YESNO, "Selection found", "Export only selected documents?") Set doc=collection.getfirstdocument 'Check if there is really a doc selected If (doc Is Nothing) And (goonwithselection) Then Msgbox "Invalid selection" Exit Sub End If Set doc = Nothing BarMsg = "Exporting selected documents ..." Else goonall = workspace.Prompt(PROMPT_YESNO, "No Selection found", "Export all documents?" + Chr$(13) + "Info: If you want to export only selected documents," + Chr$(13) + "please select these documents before running this script.") If goonall=False Then Print "Exiting..." Exit Sub End If Set collection = Nothing BarMsg = "Exporting documents ..." End If doformat = Messagebox("Format the Excel-Sheet?", 36) If doFormat = 6 Then 'SET THE AUTOFORMAT Call SetSelList() SelForm = workspace.Prompt(PROMPT_OKCANCELLIST, "AutoFormat-Form","Select the Autoformat-Form", "Simple" , SelList) TitleBar = Cint(Inputbox ( "How many degrees shall the Title-Line be turned", "Title-Turn", "0")) If Titlebar > 90 Then TitleBar = 90 Elseif TitleBar < -90 Then TitleBar = -90 End If End If SelAutoForm = getAutoForm( selForm ) 'Launch Excel and open it in the UI On Error Goto 0 Set excelAppObject = CreateObject( AppConst ) 'Try other AppConst If excelAppObject Is Nothing Then Set excelAppObject = CreateObject( AppConst2 ) If excelAppObject Is Nothing Then Msgbox "Could not create an Excel Object" Exit Sub End If End If On Error Goto ExitExcel excelAppObject.Visible = False Call excelAppObject.Workbooks.Add Set excelWorksheetObject = excelAppObject.ActiveSheet 'Add the table labels nc=64 nmore=0 Forall c In view.Columns 'do not export hidden columns or those with fixed vals (not displayed as doc.columnvalues!!!!) If Not c.ishidden And Not c.IsIcon And Not (c.IsFormula And Not Instr(1, c.Formula, "@") And Not Instr(1, c.Formula, "+")) Then nchar = countcol(nChar) excelWorksheetObject.Range( nchar + "1").Value = c.Title End If End Forall m_let = nchar nl=1 'Export Documents Set doc = view.GetFirstDocument If gowithselection Then countall = countallsel Else countall = view.AllEntries.Count countthis = 0 countthissel = 0 exitnow = False If visualProc Then Dim RefreshProgress As New ProgressBar (countall) 'display the ProcessWindow/Bar While Not ( doc Is Nothing Or exitnow) countthis = countthis + 1 If gowithselection Then Set coldoc = Nothing Set coldoc = collection.GetDocument(doc) If Not coldoc Is Nothing Then 'Exports only if doc is part of collection Call ExportDoc(excelWorksheetObject) countthissel = countthissel + 1 End If If visualproc Then UpdateMsg = "Exporting document " + Cstr(countthissel) + " of " + Cstr(countall) + Chr$(13) + "Processing Doc in View: " + Cstr(countthis) Call RefreshProgress.UpdatePosition (countthissel) Else Print "Exporting document " + Cstr(countthissel) + " of " + Cstr(countall) + " / " + "Processing Doc in View: " + Cstr(countthis) End If 'Exit routine if all selected docs are exported If countall = countthissel Then exitnow = True Else Call ExportDoc(excelWorksheetObject) UpdateMsg = "Exporting document " + Cstr(countthis) + " of " + Cstr(countall) If visualproc Then Call RefreshProgress.UpdatePosition (countthis) Else Print UpdateMsg End If End If If visualproc Then Call RefreshProgress.UpdateProgressText (BarMsg, UpdateMsg) Set doc = view.GetNextDocument(doc) Wend 'formating the Worksheet If doformat = 6 Then BarMsg = "One moment please..." UpdateMsg = "Formating the document..." If visualproc Then Call RefreshProgress.UpdateProgressText (BarMsg, UpdateMsg) Else Print Updatemsg If titlebar=0 Then excelWorksheetObject.Range("A2:" + m_let + Cstr(nl) ).Select Else excelWorksheetObject.Range("A1:" + m_let + Cstr(nl) ).Select End If excelAppObject.Selection.Columns.AutoFit excelWorksheetObject.Range("A1:" + m_let + Cstr(nl)).Select With excelAppObject.Selection .AutoFormat SelAutoForm, False, True, False, True, True, False .VerticalAlignment = -4160 End With excelWorksheetObject.Rows("1:1").Select With excelAppObject.Selection .VerticalAlignment = -4107 .HorizontalAlignment = -4108 .WrapText = True .Orientation = Cint(titlebar) .ShrinkToFit = False .MergeCells = False RowHeight = 215 End With excelWorksheetObject.Range("A:" + m_let).Select With excelAppObject.Selection.Font .Name = "Arial" .Size = 10 End With excelAppObject.Selection.Columns.Autofit excelWorksheetObject.Range("A1").Select With excelAppObject.Windows(1) .SplitRow=1 .FreezePanes=True End With With excelWorksheetObject.PageSetup .Orientation = 2 .LeftHeader = "&""Arial,Bold""&18"+db.Title+" - "+ UIViewAlias .CenterHeader = "" .RightHeader = "Datum: &D" .LeftFooter = "" .CenterFooter = "" .RightFooter = "Seite &P" .PrintArea = ("A1:"+ m_let + Cstr(nl)) .PaperSize = 9 .CenterHorizontally = True .FitToPagesTall =False .zoom = False .FitToPagesWide=1 .PrintTitleRows=excelWorksheetObject.Rows("1:1").Address End With End If excelAppObject.Visible = True Exit Sub ExitExcel: Print "Error in Line " + Cstr(Erl) + " : " + Cstr(Error) excelAppObject.DisplayAlerts = False excelAppObject.Quit Exit SubEnd SubFunction countcol( nChar As String) nc=nc+1 If nc=91 Then nmore = nmore+1 'PreChar = Axx (AC23) nc=65 'reset to A End If If nmore > 0 Then nchar=Cstr(Chr(nmore+64))+Cstr(Chr(nc)) Else nchar = Cstr(Chr(nc)) End If countcol = ncharEnd FunctionFunction getAutoForm( selForm) As Integer Select Case SelForm Case "Simple" SelAutoForm = -4154 Case "Classic1" SelAutoForm =1 Case "Classic2" SelAutoForm =2 Case "Classic3" SelAutoForm =3 Case "Accounting1" SelAutoForm =4 Case "Accounting2" SelAutoForm =5 Case "Accounting3" SelAutoForm =6 Case "Color1" SelAutoForm =7 Case "Color2" SelAutoForm =8 Case "Color3" SelAutoForm =9 Case "List1" SelAutoForm =10 Case "List2" SelAutoForm =11 Case "List3" SelAutoForm =12 Case "D3Effects1" SelAutoForm =13 Case "D3Effects2" SelAutoForm =14 Case "Accounting4" SelAutoForm =17 Case Else SelAutoForm =-4142 End Select GetAutoForm = SelAutoForm End FunctionSub SetSelList() SelList(0) = "Simple" SelList(1) = "Classic1" SelList(2) = "Classic2" SelList(3) = "Classic3" SelList(4) = "Accounting1" SelList(5) = "Accounting2" SelList(6) = "Accounting3" SelList(7) = "Accounting4" SelList(8) = "Color1" SelList(9) = "Color2" SelList(10) = "Color3" SelList(11) = "List1" SelList(12) = "List2" SelList(13) = "List3" SelList(14) = "D3Effects1" SelList(15) = "D3Effects2" SelList(16) = "None" End SubSub ExportDoc(excelWorksheetObject) On Error Goto ErrorEntry Dim nChar As String, MyString As String Dim MyVal As Variant, MyRepl(1) As Variant nl= nl+1 nc=64 nmore=0 ocount = 0 MyRepl(0) = Chr$(13)+Chr$(10) MyRepl(1) = Chr$(13) Forall c In view.Columns 'do not export hidden columns! If Not c.ishidden And Not c.IsIcon And Not (c.IsFormula And Not Instr(1, c.Formula, "@") And Not Instr(1, c.Formula, "+")) Then nchar = countcol(nChar) With excelWorksheetObject.Range(nchar + Cstr(nl)) .NumberFormat = "@" MyVal = doc.ColumnValues(ocount) If Isarray(MyVal) Then MyString = ListToText(MyVal) Else MyString = MyVal MyString = ReplaceSubString( MyString , MyRepl , Chr$(10) ) .Value = MyString End With End If ocount=ocount+1 End Forall Exit Sub ErrorEntry: With excelWorksheetObject.Range(nchar + Cstr(nl)) .NumberFormat = "@" .Value = "ERROR: WRONG VALUE" End With Resume NextEnd SubFunction ListtoText ( MyVal As Variant ) Dim NewVal As String NewVal = "" Forall x In MyVal If NewVal = "" Then NewVal = x Else NewVal = NewVal + Chr$(10) + x End If End Forall If NewVal = "" Then NewVal = MyVal Else ListtoText = NewValEnd FunctionFunction ReplaceSubString(stOriginal As String , vaAll As Variant , stTo As String) As String Dim stString As String Dim inFound As Integer,inStart As Integer,inDone As Integer stString=stOriginal Forall stWhat In vaAll If (stWhat<>stTo) Then inFound=Instr(stString,stWhat) inDone=(inFound=0) While Not inDone stString=Left(stString,inFound-1)+stTo+Mid(stString,inFound+Len(stWhat)) inStart=inFound+1 inFound=Instr(inStart,stString,stWhat) If inFound=0 Then inFound=Instr(stString,stWhat) inDone=(inFound=0) Wend End If End Forall ReplaceSubString=stStringEnd Function

Bonjour,Comme le code est dans un agent on peut être à l'extérieur de la base du moment qu'elle soit sélectionné, On peut mettre les noms des vues dans un PickList. Le premier traitement fait la recherche des fichiers voulue il les mets dans un folder, le deuxième traitement exporte les données dans un fichier Excel.[%sig%]

Je preferre la version avec le choix des colonnes, c'est super. Il nous faut intégrer la partie qui permet de reprendre la vue active avec la sélection en cours.

Enfait je suis reparti de ton export, j'ai essayé d'utiliser la collection mais je ne parvient pas à passer cette collection vers excel, jai toujours tous les documents.Voici mon code... comment faire pour que dataview que passe dans excel contienne la collection.Sub Initialize Dim Session As New NotesSession Dim db As NotesDatabase Dim sourceview As NotesView Dim sourcedoc As NotesDocument Dim dataview As NotesView Dim dc As NotesDocumentCollection Dim datadoc As NotesDocument Dim maxcols As Integer Dim WS As New Notesuiworkspace Dim ViewString As String Dim Scope As String Dim GetField As Variant Dim C As NotesViewColumn Dim FieldName As String Dim K As Integer Dim N As Integer Dim xlApp As Variant Dim xlsheet As Variant Dim rows As Integer Dim cols As Integer Dim nitem As NotesItem Dim entry As NotesViewEntry Dim vwNav As NotesViewNavigator Dim ShowView() As Variant Dim i As Integer Dim VList As Variant Dim ColVals As Variant '***********Variables pour choisir les colonnes à exporter vers excel Dim NomCol() As String Dim TabCol As Variant Dim Indice As Integer Dim ligne As Integer '***** *****Vous pouvez modifier le code pour qu'il fasse appel à une autre base de document Set db = session.CurrentDatabase '************variables pour gérer la sélection de la vue courante 'Dim view As notesview Dim doc As notesdocument Dim workspace As New NotesUIWorkspace Dim UIview As NotesUIView Dim collection As NotesDocumentCollection Dim countall As Long, countthis As Long, countallsel As Long, countthissel As Long Set UIView = workspace.CurrentView UIViewname = UIView.ViewName UIViewAlias = UIView.Viewalias Set dataview = db.GetView( UIViewName ) Set collection = db.UnprocessedDocuments gowithselection = False goonall = True '***********Determine si on a une collection (selection) countallsel = collection.count If countallsel >=1 Then gowithselection = workspace.Prompt(PROMPT_YESNO, "Selection trouvée", "Exporter uniquement les documents choisis?") Set doc=collection.getfirstdocument'***********Controler s'il ya reellement un document selectionne If (doc Is Nothing) And (goonwithselection) Then Msgbox " Selection invalide" Exit Sub End If Set doc = Nothing BarMsg = "Export des documents selectionnés..." Else goonall = workspace.Prompt(PROMPT_YESNO, "Pas Selection active", "Export tous les documents?" + Chr$(13) + "Info: Si vous souhaitez exporteruniquement les documents sélectionnés," + Chr$(13) + "Sselectionnez ces documents avant de lancer cette action.") If goonall=False Then Print "Sortie..." Exit Sub End If Set collection = Nothing BarMsg = "Export des documents ..." End If Set dataview = db.getview(UIViewname) ' Ouvre la vue Set vwnav= dataview.createViewnav() rows = 1 cols = 1 maxcols=dataview.ColumnCount ' Récupère le nombre de colonne '*****************Choisir les colonnes à exporter vers excel Redim NomCol(Ubound(dataview.Columns)) As String 'Redim NomCol(Ubound(Vue.Columns)) As String Indice = 0 Forall Colonne In dataview.Columns If Colonne.Title <> "" And Colonne.IsHidden = False Then NomCol(indice) = Colonne.Title + "|" + Str$(Indice) Indice = Indice + 1 End Forall TabCol = ws.Prompt(PROMPT_OKCANCELLISTMULT, "Exportation vers Excel", _ "Sélectionnez les colonnes à exporter","" , Fulltrim(NomCol)) If Not Isempty(TabCol) Then For indice = 0 To Ubound(TabCol) TabCol(Indice) = Trim(Right(TabCol(Indice), 2)) Next End If '********************Ouverture d'une feuille excel Set xlApp = CreateObject("Excel.Application")' Lance Excel xlApp.StatusBar = "Création du tableau. Veuillez patienter..." xlApp.Visible = True xlApp.Workbooks.Add xlApp.ReferenceStyle = 2 Set xlsheet = xlApp.Workbooks(1).Worksheets(1) ' On prend la première feuille du classeur ' ********************On met le titre de la vue xlsheet.Cells(rows,cols).Value ="Vue : " + UIViewname+ ", de la base : " + db.title +", extraction du : " + Format(Now,"mm/dd/yyyy HH:MM") xlApp.StatusBar = "Création des entêtes de colonnes. Veuillez patienter..." rows=2 ' On commence à la deuxième ligne '**********************On affiche le titre des colonnes choisies For IndiceTab = 0 To Ubound(TabCol) Set c=dataview.Columns(Val(TabCol(IndiceTab))) xlsheet.Cells(rows,cols).Value = c.title cols = cols + 1 Next '************************On affiches les valeurs des colonnes Set entry=vwnav.GetFirstDocument rows=3 ' On se place sur la troisième ligne Do While Not (entry Is Nothing) cols=1 For IndiceTab = 0 To Ubound(TabCol) colvals=entry.ColumnValues(Val(TabCol(IndiceTab))) 'Select Case scope 'Case "STRING" 'xlsheet.Cells(rows,cols).Value ="'" + colvals 'Case Else xlsheet.Cells(rows,cols).Value = colvals 'End Select cols=cols+1 Next xlApp.StatusBar = "Importation des données - Document " & rows-1 '& " sur " & dc.count & "." rows=rows+1 Set entry = vwnav.getnextdocument(entry) Loop '**************************Mise en page des données excel xlApp.Rows("1:1").Select xlApp.Selection.Font.Bold = True xlApp.Selection.Font.Underline = True xlApp.Range(xlsheet.Cells(2,1), xlsheet.Cells(rows,maxcols)).Select xlApp.Selection.Font.Name = "Arial" xlApp.Selection.Font.Size = 9 xlApp.Selection.Columns.AutoFit With xlApp.Worksheets(1) .PageSetup.Orientation = 2 .PageSetup.centerheader = "Rapport" .Pagesetup.RightFooter = "Page &P" & Chr$(13) & "Date : &D" .Pagesetup.CenterFooter = "" End With xlApp.ReferenceStyle = 1 xlApp.Range("A1").Select xlApp.StatusBar = "L'importation des données de Lotus Notes est terminé." '******************* Vous pouvez activer la ligne ci-dessous si vous voulez enregistrer le document en automatique'xlapp.ActiveWorkbook.saveas "C:\Vue" + Trim(Format(Now,"yyy")) ' Sauve le document dataview.clear Set xlapp=Nothing ' Stop l'automation excel Set db=NothingEnd Sub