Hallo zusammen,
ich habe mir ein Script zum Export von Daten nach Excel zusammengebastelt.
Das Script funktioniert (fast) reibungslos. Nur wird leider die erste Datenzeile entweder nicht übertragen oder sie wird gelöscht. Das kann ich leider nicht so genau definieren, da ich diese nicht sehe.
Könnte sich mal bitte jemand mein Script ansehen und mir den Fehler mitteilen?
Vielen Dank für die Hilfe
Markus
Sub Click(Source As Button)
On Error Resume Next
Dim session As New NotesSession
Dim wks As New NotesUIWorkspace
Dim db As NotesDatabase
Dim view As NotesView
Dim doc As NotesDocument
Dim column As NotesViewColumn
Dim uidoc As NotesUIDocument
Set uidoc = wks.CurrentDocument
Dim xlApp As Variant, xlsheet As Variant, xlwb As Variant, tempval As Variant
Dim DataArray
Dim VColumns List As String
Redim DataArray(0, 80) As String '80 = Max Columns, ggf. anpassen
Ansicht = "$alle" 'hier die richtige Ansicht eintragen
Set db=session.CurrentDatabase
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlwb=xlApp.Workbooks.Add
Set xlsheet =xlwb.Worksheets(1)
With xlwb
.FileFormat = -4143 ' -4143 = Format xls 97-2003
End With
Set view = db.GetView(Ansicht)
Dim Formula As String
Dim Formula_Original As String
Formula_Original = view.SelectionFormula
Formula = uidoc.FieldGetText("ViewFormula")
If Formula <> "" Then
view.SelectionFormula = Formula
Else
view.SelectionFormula = Formula_Original
End If
view.Refresh
Call uidoc.FieldSetText("ViewFormula", Formula_Original)
arrcnt=0
row=1
colcounter=0
rowsatonce=20
Forall c In view.Columns
If c.isHidden = False Then ' do not include hidden columns
If c.isIcon = False Then ' do not include icon columns
If c.Formula<>"""1""" And c.Formula<>"1" Then 'do not include columns which are used for counting docs (Total)
colcounter=colcounter+1
DataArray(row-1, colcounter-1) =c.Title
VColumns(Cstr(cn))=Cstr(cn)
End If
End If
End If
cn=cn+1
End Forall
Redim Preserve DataArray(0, colcounter-1) As String
xlsheet.Range("A1").Resize(1, colcounter).Value = DataArray ' set column names
Redim DataArray(rowsatonce-1, colcounter-1) As String
row=2
x=0
Print "Exportiere Daten"
Set doc = view.GetFirstDocument
While Not ( doc Is Nothing )
Forall col In VColumns
currentvalue=""
tempval= doc.ColumnValues(Val(col))
If Isarray(tempval) Then
Forall v In tempval
If currentvalue="" Then
currentvalue=v
Else
currentvalue=currentvalue+","+v
End If
End Forall
Else
currentvalue=tempval
End If
x=x+1
DataArray(arrcounter, x-1) =currentvalue
End Forall
x=0
row=row+1
arrcounter=arrcounter+1
If arrcounter/rowsatonce=arrcounter\rowsatonce And arrcounter<>0 Then
xlsheet.Range("A"+Cstr(arrcnt*rowsatonce+2)).Resize(rowsatonce, colcounter).Value = DataArray
arrcnt=arrcnt+1
arrcounter=0
Redim DataArray(rowsatonce-1, colcounter-1) As String
End If
Set doc = view.GetNextDocument (doc)
Wend
If arrcounter/rowsatonce<>arrcounter\rowsatonce And arrcounter>0 Then
xlsheet.Range("A"+Cstr(arrcnt*rowsatonce+2)).Resize(arrcounter, colcounter).Value = DataArray
End If
End Sub
