title image


Smiley URL nicht, aber vielleicht reicht das ja schon....
Hallo Rolf,erstell dir eine Ansicht "EXPORT". Dort lässt du alle Felder anzeigen die du Exportieren willst. Wenn du das ganze Doc brauchst musst du für jedes Feld ne Spalte machen, ein bischen aufwendig, aber ist ja ne einmalige Sache. In der Ansicht sollte die Spaltenbezeichnung mit dem angezeigten Feldnamen übereinstimmen. Dann kannst du in jeder beliebigen Ansicht der DB dieses Script in einer Aktionsschaltfläche nutzen, exportiert werden nur die selektierten Datensätze. Viel Spaß: Dim s As New notessession Dim db As notesdatabase Dim view As notesview Dim dc As notesdocumentcollection Dim doc As notesdocument Dim vcols As Variant Dim Uvcols As Integer Set db = s.currentdatabase Set dc = db.unprocesseddocuments If dc.count = 0 Then Msgbox "Keine Dokumente ausgewählt!" End End If Set view = db.getview("EXPORT") Uvcols = Ubound(view.Columns) Dim xlApp As Variant Dim xlsheet As Variant Set xlApp = CreateObject("Excel.Application") xlApp.StatusBar = "Erstelle Arbeitsblatt. Bitte warten..." xlApp.Visible = True xlApp.Workbooks.Add xlApp.ReferenceStyle = 2 Set xlsheet = xlApp.Workbooks(1).Worksheets(1) xlsheet.Name = "Export" Dim rows As Integer rows = 1 Dim cols As Integer cols = 1 Dim maxcols As Integer For x=0 To Ubound(view.Columns) xlApp.StatusBar = "Erstelle Spalten und Spaltenüberschirften..." If view.Columns(x).IsHidden = False Then If view.Columns(x).Title "" Then xlsheet.Cells(rows,cols).Value = view.Columns(x).Title cols = cols + 1 End If End If Next maxcols = cols - 1 Set doc = dc.getfirstdocument Dim fieldname As String Dim fitem As notesitem rows=2 cols=1 Do While Not (doc Is Nothing) For x=0 To Ubound(view.Columns) xlApp.StatusBar = "Importiere Daten aus der LotusNotes-DB. Bitte warten..." If view.Columns(x).IsHidden = False Then If view.Columns(x).Title "" Then fieldname = view.Columns(x).Itemname Set fitem = doc.getFirstItem(fieldname) If Not (fitem Is Nothing) Then xlsheet.Cells(rows,cols).Value = fitem.Text cols = cols+1 Else xlsheet.Cells(rows,cols).Value = "" cols = cols+1 End If End If End If Next rows = rows+1 cols =1 Set doc = dc.getnextdocument(doc) Loop xlApp.Rows("1:1").Select xlApp.Selection.Font.Bold = True xlApp.Range(xlsheet.Cells(1,1), xlsheet.Cells(rows,maxcols)).Select xlApp.Selection.Font.Name = "Arial" xlApp.Selection.Font.Size = 12 xlApp.Selection.Columns.AutoFit With xlApp.Worksheets(1) .PageSetup.Orientation = 2 .PageSetup.centerheader = "Export aus Notes" .Pagesetup.RightFooter = "Seite &P" & Chr$(13) & "Datum: &D" .Pagesetup.CenterFooter = "" End With xlApp.ReferenceStyle = 1 xlApp.Range("A1").Select xlApp.StatusBar = "Import abgeschlossen."Christian
Nutzt bitte auch ab und zu die "Archiv"-Schaltfläche!!
So geht preigegebenes Wissen nicht verloren :-))


geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: