Excelexport mit einzelnen Items?

[OCS]

Hallo zusammen,
möchte mir aus einer bestehenden Kunden DB die Ansprechpartner mit Mailadresse, Tel. usw... in Excel exportieren. Hab mir hierzu mal die Exportfunktion hier aus dem Forum als Grundlage genommen.... Hoffe das is ok!

Jetz zu meinem Problem:

Ich möchte nicht (wie in der Version aus dem Forum...) eine komplette Ansicht exportieren, sondern lediglich die Dokumente aus der Collection....  Hat jemmand einen Plan wie das geht?

Code aus dem Forum:

Dim Session As New NotesSession
   Dim thisdb As NotesDatabase 'Diese Datenbank
   Dim db As NotesDatabase 'Die DB für Excel-Export
   Dim sourceview As NotesView,sourcedoc As NotesDocument
   Dim dataview As NotesView, dc As NotesDocumentCollection
   Dim datadoc As NotesDocument, maxcols As Integer
   Dim profiledoc As NotesDocument
   Dim WS As New Notesuiworkspace
   Dim ViewString As String, Scope As String, GetField As Variant
   Dim C As NotesViewColumn, FieldName As String, K As Integer,N As Integer
   Dim xlApp As Variant, xlsheet As Variant, rows As Integer, cols As Integer
   Dim nitem As NotesItem  , entry As NotesViewEntry, vwNav As NotesViewNavigator
   Dim ShowView()  As Variant, i As Integer, VList As Variant, ColVals As Variant
   Dim datetime As New NotesDateTime( "" )   
   Dim nowtime As String
   dateTime.LSLocalTime = Now      
   Call dateTime.SetNow     
   now_Time = dateTime.LocalTime
   now_time = Left$(now_time, 10)
   Print "Übergabe an Excel beginnt!!!"
   
'MEINE DIM's +++++++++++++++++++++++++++++++++++++++++
   Set thisdb = session.CurrentDatabase
   Set profiledoc = thisdb.GetProfileDocument("ProfileExcel")
   
   
'+++++++++++++++++++++++++++++
   
   'Datenbank bestimmen, aus der die Daten exportiert werden sollen:   
   Set db = New NotesDatabase ("OCS02","vis\pilot\public\db\topf\vis.nsf")
   
   'Ansicht bestimmen, aus der die Daten exportiert werden sollen:
   Set dataview = db.getview("person2")  'get view "Auswertung Excel"
   
   Set vwnav= dataview.createViewnav()
   
   rows = 1
   cols = 1
   maxcols=dataview.ColumnCount  'how many columns?
   
   Set xlApp = CreateObject("Excel.Application")  'start Excel with OLE Automation
   xlApp.StatusBar = "Creating WorkSheet. Please be patient..."
   xlApp.Visible = False
   xlApp.Workbooks.Add
   xlApp.ReferenceStyle = 2
   Set xlsheet = xlApp.Workbooks(1).Worksheets(1)   'select first worksheet
   
         'worksheet title
   xlsheet.Cells(rows,cols).Value ="View for UBS: " + ViewString + ", from Database: " +  db.title +",  Extract created on: " +  Format(Now,"mm/dd/yyyy HH:MM")
   
   xlApp.StatusBar = "Creating Column Heading. Please be patient..."
   
   rows=2  'column headings starts in row 2
   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   'data starts in third row
   Do While Not (entry Is Nothing)
      
      For cols=1 To maxcols   
         colvals=entry.ColumnValues(cols-1)      'subscript =0
         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 = "Importing Notes Data   -    Document " & rows-1 '& " of " & dc.count & "." 
      rows=rows+1
      Set entry = vwnav.getnextdocument(entry)       
      
      
      i = maxcols \50
      k =1
      Print Left( sProgress, k )  + ">" + " " Cstr( i ) + " von " Cstr(tmaxcols)
      k = k + 1
      
      
   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 = "Report - Confidential"
      .Pagesetup.RightFooter = "Page &P" & Chr$(13) & "Date: &D"
      .Pagesetup.CenterFooter = ""
   End With
   xlApp.ReferenceStyle = 1
   xlApp.Range("A1").Select
   xlApp.StatusBar = "Importing Data from Lotus Notes Application was Completed."
         'xlapp.ActiveWorkbook.saveas "c:VX" + Trim(Format(Now,"yyy"))   'save with generated name
   dataview.clear
   
'   Öffnen der Datei, die die weiterbearbeiteneden Makros enhält:
   'xlApp.Workbooks.Open "H:\OCS\F_Verwaltung\Auftragsabwicklung\Auswertungen\Vorlagen\Support_F.xls"
'   zunächst wird die alte Datei gelöscht (H:\OCS\F_Verwaltung\Auftragsabwicklung\Auswertungen\Vorlagen\Support_Auswertung.xls)
   'xlApp.Run "Support_F.xls!loeschen"
'   danach wird die Excel-Makro Datei zunächst wieder geschlossen
   'xlApp.ActiveWorkbook.Close 'at
   
'   Jetzt können die neu übernommenen Daten gespeichert werden.   
   now_time = "H:\OCS\C_Vertrieb\Vis_Adressen " + Left$(now_time, 10) + ".xls"
   
   xlApp.activeworkbook.SaveAs now_time
   xlApp.ActiveWorkbook.Close 'at
   
'   Öffnen der Datei, die die weiterbearbeiteneden Makros enhält:
   'xlApp.Workbooks.Open "H:\OCS\F_Verwaltung\Auftragsabwicklung\Auswertungen\Vorlagen\Support_F.xls"
   
'   Makro starten:
'   xlApp.Run ("H:\OCS\F_Verwaltung\Auftragsabwicklung\Auswertungen\Vorlagen\Support_Test.xls!Makro1")
   'xlApp.Run "Support_F.xls!Ablauf"
   
   Set xlapp=Nothing   'stop OLE
   Set db=Nothing
   'xlApp.Close
   Msgbox "Datei unter " + "H:\OCS\C_Vertrieb\Vis_Adressen " + Left$(now_time, 10) + ".xls gespeichert"
End Sub
   
Gruß Björn

[diali]

an der Stelle

Code

 'Ansicht bestimmen, aus der die Daten exportiert werden sollen:
   Set dataview = db.getview("person2")  'get view "Auswertung Excel"

musst Du Dir eine NotesDocumentCollection holen.
Mit xlsheet.Cells(rows,cols).Value = NotesDocument.Feldname(0) kannst Du dann die Feldwerte (0)  in die Tabellenzelle schreiben.

Nach dem Loop wird nur noch Formatierung und die Speicherung des Dokumentes dürchgeführt.

[ata]

... wenn du die markiereten Dokumente einer Ansicht haben möchtest, dann benötigst du nur die aktuelle Datenbank - und initialisiert alle markierten Dokumente...

Code

Dim session as New NotesSession
Dim dbthis As NotesDatabase
Dim dc As NotesDocumentCollection
Dim datadoc As NotesDocument

Set dbthis = session.CurrentDatabase
Set dc = dbthis.UnprocessedDocuments

Diese Dokumente durchläufst du dann...

Code

If dc.Count > 0 Then
   ' # Excel initialisieren
   ' ...
   Set datadoc = dc.getFirstDocument
   While not datadoc Is Nothing
      ' # die Verarbeitung der Datendokumente => die Werte nach Excel exportieren
      '...
      ' # das nächste Dokument initialisieren
      Set datadoc = dc.GetNextDocument
   Wend
   ' # Excel sichtbar machen - oder was auch immer
   ' ...
End If

Toni