Schönen guten Tag alle zusammen,
ich benötige mal wieder eure Hilfe bei einem kleinen Export Problem. Ich habe bereits versucht, Lösungen im Forum zu finden (über die Suche) - leider ohne Erfolg. Ich habe zwar inzwischen einige leichtere Anwendungen erstellt, jedoch bin ich noch ziemlich am Anfang. Ich erläutere mal mein Problem im Detail:
- Ich habe eine Anwendung gebastelt, welche zur Auswertung von Sonderkonditionen genutzt werden soll. Dabei habe ich darauf geachtet, dass die Anwendung so leicht wie möglich zu bedienen ist. Es gibt daher eine Aktionsschaltfläche, welche nach der Betätigung die verfügbaren Ansichten anzeigt und die ausgewählte anschließend in Excel exportiert. In meinen Tests verlief dies auch alles Problemlos (Hatte jedoch nur mit ca. 200 Dokumenten getestet. Inzwischen sind in der Anwendung jedoch über 500 Dokumente enthalten und ab dem 209 exportierten Datensatz erscheint die Meldung "OLE: Automation object error" und der Export bricht mittendrin ab. Wir nutzen im Betrieb aktuell Office 2003 (habe dies in meiner Testumgebung jedoch schon mit Office 2010 versucht).
- Die Aktion welche den Export auslöst startet einen Agenten und dieser enthält den folgenden Code:
Sub Initialize
Dim Session As New NotesSession ,db As NotesDatabase
Dim sourceview As NotesView,sourcedoc As NotesDocument
Dim dataview As NotesView, dc As NotesDocumentCollection
Dim datadoc As NotesDocument, maxcols As Integer
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
Set db = session.CurrentDatabase 'link to current database
'fetch then display a list of views in the database
Vlist= db.views
K=Ubound(Vlist) 'get size of list
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 'do not show hidden views
N=N+1
ShowView(N) = FieldName
End If
End If
Next i
Redim Preserve ShowView(N)
'now sort the list - by default views are listing in the order that they were created
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,"List of Views","Choose a View","",ShowView )
If Len(viewstring)=0 Then Exit Sub
'ViewString ="Dan's View"
Set dataview = db.getview(ViewString) 'get selected view
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 = True
xlApp.Workbooks.Add
xlApp.ReferenceStyle = 2
Set xlsheet = xlApp.Workbooks(1).Worksheets(1) 'select first worksheet
'worksheet title
xlsheet.Cells(rows,cols).Value ="View: " + 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)
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
Set xlapp=Nothing 'stop OLE
Set db=Nothing
End Sub
Ich bin mir ziemlich sicher, dass ich den Code hier im Forum gefunden habe. Ich habe schon diverse Anpassungen versucht - leider ohne Erfolg. Kann mir bitte Jemand sagen, wo der Fehler steckt?
Vielleicht habt Ihr ja auch Ideen, was ich besser/anders machen soll/kann. Bin über jeden Hinweis in die richtige Richtung dankbar. Danke schonmal