DominoArea.org [Archive]

[syntax="LotusScript"]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

'***** Vous pouvez modifier le code pour qu'il fasse appel à une autre base de document
Set db = session.CurrentDatabase

Vlist= db.views ' Récupère les vue de la base
K=Ubound(Vlist) ' Récupère le nombre de vue
Redim Preserve ShowView(K)
N=-1
For i = 0 To K
If Len(Vlist(i).Name) >0 Then
FieldName=Trim(Vlist(i).Name)
If Mid(Fieldname,1,1) <>"(" Then ' On n'affiche pas les vues caché
N=N+1
ShowView(N) = FieldName
End If
End If
Next i
Redim Preserve ShowView(N)
' Trie les vues par ordre alphabétique
For i=0 To N
For K=i To N
If ShowView(i) > ShowView(k) Then
FieldName=ShowView(i)
ShowView(i) = ShowView(k)
ShowView(k)=FieldName
End If
Next k
Next i

viewstring= ws.Prompt(PROMPT_OKCANCELLIST,"Liste des vues","Choisissez une
vue","",ShowView )
If Len(viewstring)=0 Then Exit Sub

Set dataview = db.getview(ViewString) ' Ouvre la vue

Set vwnav= dataview.createViewnav()

rows = 1
cols = 1
maxcols=dataview.ColumnCount ' Récupère le nombre de colonne

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 : " + ViewString + ", 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
For K=1 To maxcols
Set c=dataview.columns(K-1)
xlsheet.Cells(rows,cols).Value = c.title
cols = cols + 1
Next K

Set entry=vwnav.GetFirstDocument
rows=3 ' On se place sur la troisième ligne
Do While Not (entry Is Nothing)

For cols=1 To maxcols
colvals=entry.ColumnValues(cols-1)
scope=Typename(colvals)
Select Case scope
Case "STRING"
xlsheet.Cells(rows,cols).Value ="'" + colvals
Case Else
xlsheet.Cells(rows,cols).Value = colvals
End Select
Next cols
xlApp.StatusBar = "Importation des données - Document " & rows-1 '& " sur " & dc.count & "."
rows=rows+1
Set entry = vwnav.getnextdocument(entry)
Loop

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=Nothing
End Sub[/syntax]

J'ai un "Subscript out of range" sur la ligne " colvals=entry.ColumnValues(cols-1) "

Salut,

C'est que la vue à trop d'entrée. entry.ColumnValues est dans une dll codée en C et non en C++, j'espère que sur la version 7 qu'IBM la refaite.