Je me suis fait une mini appli pour lister des utilisateurs d'un annuaire...
J'ai récupéré du code pour faire un extract Excel de la vue (ce qui marche très bien). Je voudrais en fait améliorer le script pour n'exporter que les documents que je sélectionne
Script actuel (qui exporte toutes les entrées de la vue)
- Code : Tout sélectionner
Sub Click(Source As Button)
Dim session As New NotesSession
Dim db As NotesDatabase
Dim view As NotesView
Dim chemin As String
Set db = Session.GetDatabase("MONSERVEUR","names.nsf",False)
Set view = db.GetView( "NOMDEMAVUE" )
chemin = Inputbox$ ("Où voulez vous enregistrer l'export Excel?", "Chemin du fichier" ,"C:\Export.xls")
If chemin = "" Then
Msgbox "Opération annulée",64,"Erreur"
Exit Sub
End If
Call ExportView(view, chemin,Chr(9) )
End Sub
et
- Code : Tout sélectionner
Sub ExportView(pView As NotesView, pPathAndFileName As String, pDelimiter As String)
'USAGE:
'Call ExportView(<View>, <PathAndFileName>, <Delimeter>)
'Where <View> is the view to export, <PathAndFileName> is the path and file name to write to, and <Delimiter> is the delimeter (or separator) IE: ","
'RETURN VALUE:
'N/A
Dim doc As NotesDocument
Dim ExportLine As String
Dim LineCount As Long
Dim compteur As Long
'Open the File Handle
ExportFile = Freefile
Open pPathAndFileName For Output As ExportFile
'===========================Calcul nb d'entrée===================================================
Print "Préparation de l'exportation... "
compteur=pview.EntryCount
'=============================================================================================
'Begin loop through the view
Set doc = pView.GetFirstDocument
While Not (doc Is Nothing)
'Initialize the export line
ExportLine = ""
'Use the ColumnValues property of the document as defined in NotesDocument. Returns what appears in the view.
Forall item In doc.ColumnValues
'Since this is the first line just add the text value
If ExportLine= "" And LineCount=0 Then
'ExportLine = Trim(Cstr(item))
ExportLine= "Date de Création"& Chr(9) & "Adresse Mail" & Chr(9) & "Prénom" & Chr(9) & "Nom" & Chr(9) & "redirigé vers..." & Chr(13)
End If
'Just in case the view has a list displayed........Avoid the error. Lists should not be in views that are to be exported due to lists being dynamic.
If Not Isarray(item) Then
'Append the Export Line with the current text value
ExportLine = ExportLine & Trim(Cstr(item)) & pDelimiter
Else
'If it is an array just return the first item of the list
ExportLine = ExportLine & Trim(Cstr(item(0))) & pDelimiter
End If
End Forall
'Increment Counter
LineCount = LineCount + 1
'Update Status
'Print "Exportation en cours... " & Cstr(LineCount)
Print "Exportation en cours... "& Int(100*LineCount/compteur) & "%"
'Write line to the file handle
Print #ExportFile, ExportLine
'Get the next document
Set doc = pView.GetNextDocument(doc)
Wend
Msgbox Cstr(LineCount) & " documents exportés." & Chr(13) & Chr(13) & "Fichier enregistré sous " & pPathAndFileName, 64 ,"Exportation Complète"
'Reset File Handles
Close
Reset
'============================OUVERTURE EXCEL + MISE EN FORME=======================
Dim XLApp As Variant
Dim XLWorkBook As Variant
Dim ActiveWorkBook As Variant
Dim Sheet As Variant
Dim Cellule As Variant
'Ouverture de l'appli Excel
Set XLApp = CreateObject("Excel.Application")
XLApp.visible=True
Set XLWorkBook=XLApp.WorkBooks
XLApp.DisplayAlerts=False
XLApp.StatusBar = "Traitement en cours…."
'Ouverture et activation du classeur
XLWorkBook.Open pPathAndFileName
Set ActiveWorkBook=XLApp.ActiveWorkBook
Set Sheet=ActiveWorkBook.ActiveSheet
Set Cellule=Sheet.Cells
'Mise en page du doc (Gras et autofit)
Sheet.Rows("1").font.bold=True
Sheet.Columns("A:N").autoFit
'Sauvegarde du fichier
ActiveWorkBook.SaveAs(pPathAndFileName & "1.xls")
End Sub
Pouvez vous m'aider à faire mon exctraction mais seulement avec des documents que j'aurai selectionné (et non tous les document comme ici)?
Merci
