Das Notes Forum
Domino 9 und frühere Versionen => Entwicklung => Thema gestartet von: Wiesel am 24.08.06 - 15:54:27
-
Hallo!
Ich habe hier einen tollen Programmcode im Forum empfohlen bekommen, der auch ganz prima klappt.
Allerdings möchte ich in eine bestimmte Exceldatei meine Daten reinschreiben und weiß nicht, wie ich mir diese holen kann.
Im Programmcode gibt es ja die Zeile:
Set vExcelApp = CreateObject("Excel.Application") 'Start Excel with OLE
Ich möchte aber nicht einfach nur Excel starten und meine Zeilen aus der Ansicht darin übertragen, sondern ich möchte eine Dokumentvorlage, die an einer bestimmten Stelle im Laufwerk lieder zugreifen und meine Zeilen dorthin übertragen.
Aber wie geht das???
Danke und Gruß,
Wiesel
-
Call vExcelApp.Workbooks.Open ("Laufwerk:\Verzeichnis\Dateiname.xls")
sollte es tun
Andreas
-
Funktioniert leider nicht. Da gibts eine Fehlermeldung an einer späteren Stelle im Code.
-
Verräts Du uns denn auch welche Meldung an welcher Stelle kommt? Vielleicht mal den Debugger einschalten!
Andreas
-
Sorry, hatte gestern wenig Zeit.
Folgende Fehlermeldung wird angezeigt:
Error: 213 - Microsoft Excel: Die Select-Methode des Range-Objektes ist fehlerhaft.
Procedure: ExcelExportLib: Sub ExcelExport
Line: 140
Und hier der Script mit der "Line 140":
Public Sub ExcelExport (strViewName As String)
On Error Goto ErrorHandler
Dim session As New Notessession
Dim db As NotesDatabase
Dim view As NotesView
Dim viewColumn As NotesViewColumn
Dim viewentry As NotesViewEntry
Dim iRows As Integer
Dim iCols As Integer
Dim iColQuantity As Integer
Dim iK As Integer
Dim lDocQuantity As Long
Dim vColValues As Variant
Dim strColValue As String
Dim vExcelApp As Variant
Dim vExcelSheet As Variant
'----> Excel constants
Const xlInsideHorizontal& = 12
Const xlInsideVertical& = 11
Const xlEdgeBottom& = 9
Const xlEdgeLeft& = 7
Const xlEdgeRight& = 10
Const xlEdgeTop& = 8
Const xlContinuous& = 1
Const xlCenter& = -4108
'<----
Set db = session.CurrentDatabase
Set view = db.getview(strViewName) 'View for Excel Export
Dim vc As NotesViewEntryCollection
Set vc = view.AllEntries
lDocQuantity = vc.Count 'Number of documents in the view to Export to Excel
If lDocQuantity = 0 Then
Msgbox "Die Ansicht enthält keine Dokumente.", 64, "Excel Export abgebrochen"
Goto ExitScript
End If
Set vExcelApp = CreateObject("Excel.Application") 'Start Excel with OLE
vExcelApp.Workbooks.Open "M:\Lotus Notes\Projekt\Dateiname.xls"
On Error Goto ErrorHandlerExcelOpen
vExcelApp.Application.ScreenUpdating = False
vExcelApp.Visible = False
vExcelApp.Workbooks.Add
vExcelApp.ReferenceStyle = 2
'---> If there are more than 1 worksheets, we delete them.
If vExcelApp.Worksheets.Count > 1 Then
vExcelApp.DisplayAlerts = False
While vExcelApp.Worksheets.Count > 1
vExcelApp.Worksheets(2).Delete
Wend
vExcelApp.DisplayAlerts = True
End If
'<----
Set vExcelSheet = vExcelApp.Workbooks(1).Worksheets(1) 'Select the first worksheet
vExcelSheet.Name = "LotusNotesExport" 'Set new worksheet name
iRows=1 'Column headings starts in row 1
iCols = 1 'Column headings starts in column 1
iColQuantity=view.ColumnCount 'How many columns in the view?
For iK=1 To iColQuantity
Set viewColumn=view.columns(iK-1)
vExcelSheet.Cells(iRows,iCols).Value = viewColumn.title
iCols = iCols + 1
Next iK
iRows=2 'Data starts in 2nd row
'---> ####### Main Code: Filling Excel with all the documents #######
Dim pb As New LNProgressBar(True) 'Progress Bar
Set viewentry = vc.GetFirstEntry()
Do While Not (viewentry Is Nothing)
For iCols=1 To iColQuantity
vColValues=viewentry.ColumnValues(iCols-1)
'---> Implode
strColValue = AtImplode(vColValues, Chr(10))
'<--- Implode
'---> Remove square wordwrap - chars ()
While Instr ( strColValue, Chr(13) ) > 0
strColValue = Left$(strColValue, Instr ( strColValue,Chr(13) ) - 1) & "" & Right$(strColValue, Len(strColValue) - Instr ( strColValue, Chr(13) ))
Wend
'<---
vExcelSheet.Cells(iRows,iCols).Value = strColValue
Next iCols
'---> ProgressBar
Call pb.SetText("Export der Dokumente nach Excel","Line " & iRows-1 & " of " & lDocQuantity & " exported")
Call pb.SetProgressRange(lDocQuantity) ' max range of progress bar - must be long-datatype
Call pb.SetProgressPos(iRows-1) ' current integer
'<---- ProgressBar
iRows=iRows+1
Set viewentry = vc.GetNextEntry(viewentry)
Loop
'<----
'---> Format first line
'UND HIER KOMMT DIE ZEILE 140:
vExcelApp.Range(vExcelSheet.Cells(1,1), vExcelSheet.Cells(1,iColQuantity)).Select 'Select first line
With vExcelApp.Selection
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.ColorIndex = 2
.Interior.ColorIndex = 47
End With
'<----
' ---> Freeze first line
vExcelApp.Range("A2").Select
vExcelApp.ActiveWindow.FreezePanes = True
'<---
' ---> Format remaining lines
vExcelApp.Range(vExcelSheet.Cells(2,1), vExcelSheet.Cells(iRows,iColQuantity)).Select 'select the whole data except line 1
'<---
With vExcelApp.Worksheets(1)
.PageSetup.Orientation = 2 'landscape format
'Header and footer
.PageSetup.centerheader = "&""Arial,Fett""Notes-Excel-Export from database: " + db.title +"; Extract created on: " + Format(Now,"dd/MM/yyyy HH:MM")
.Pagesetup.RightFooter = ""
.Pagesetup.CenterFooter = ""
.PageSetup.PrintTitleRows = "$1:$1" 'repeat first line on every page
End With
vExcelApp.ReferenceStyle = 1 'Set column and line - header to "A1" (and not "Z1S1")
'---> Format all cells
vExcelApp.Range(vExcelSheet.Cells(1,1), vExcelSheet.Cells(iRows-1,iColQuantity)).Select 'Select the whole data
With vExcelApp.Selection
.Font.Name = "Arial"
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
'<----
'---> remove gridlines and set page zoom
vExcelApp.ActiveWindow.DisplayGridlines = False
vExcelApp.ActiveWindow.Zoom = 91
'<---
'---> Select all and fit column width
vExcelApp.Cells.Select
vExcelApp.Selection.Columns.AutoFit
'<----
'Finalizing.......
vExcelApp.Range("A2").Select
vExcelApp.Application.ScreenUpdating = True
vExcelApp.StatusBar = lDocQuantity & " documents successful imported ...."
vExcelApp.Visible = True
view.clear 'Clears the full-text search filtering on the view
Set vExcelApp=Nothing 'stop OLE
Set db=Nothing
ExitScript:
Exit Sub
ErrorHandler:
Call ErrorMessage("ExcelExportLib: Sub ExcelExport")
Resume ExitScript
ErrorHandlerExcelOpen:
vExcelApp.DisplayAlerts = False
vExcelApp.Quit
Call ErrorMessage("ExcelExportLib: Sub ExcelExport")
Resume ExitScript
End Sub
-
Du rufst die Select-Methode falsch auf.
Versuch's mal so:
Dim strSelection As String
...
strSelection = "A1:A" & Trim$(Str$(iColQuantity))
vExcelApp.Range(strSelection).Select 'Select first line
....
Axel
-
Ist das dann richtig, wenn ich die Zeile
vExcelApp.Range(vExcelSheet.Cells(2,1), vExcelSheet.Cells(iRows,iColQuantity)).Select 'select the whole data except line 1
so ändere:
strSelection = "A2:A" & Trim$(Str$(iColQuantity))
vExcelApp.Range(strSelection).Select 'Select first line
Ich weiß dann allerdings nicht, wie ich "iRows" dort mit einbaue.
Das Gleiche habe ich dann nochmal mit der Zeile:
vExcelApp.Range(vExcelSheet.Cells(1,1), vExcelSheet.Cells(iRows-1,iColQuantity)).Select 'Select the whole data
strSelection = "A1:A" & Trim$(Str$(iColQuantity))
vExcelApp.Range(strSelection).Select 'Select first line
Wenn ich das so ändere, bekomme ich eine Fehlermeldung für Zeile 183:
Error 213: Die LineStyle-Eigenschaft des Border-Objektes kann nicht festgelegt werden.
Was mache ich hier???
-
vExcelApp.Range(vExcelSheet.Cells(2,1), vExcelSheet.Cells(iRows,iColQuantity)).Select 'select the whole data except line 1
müsste dann so aussehen:
strSelection = "B2:" & Chr$(65+ iRows)&Trim$(Str$(iColQuantity))
vExcelApp.Range(strSelection).Select 'select the whole data except line 1
Axel
-
Ok, das klappt jetzt schon mal ohne irgendwelche Fehlermeldungen. Danke.
Folgende Unstimmigkeit tut sich jetzt aber in Excel auf.
Es wird neben der angegebenen Datei eine weitere Datei erstellt (Mappe1.xls). In der steht man erst drin und kann dann über das Menü Fenster in die andere Datei gehen. Die ist auch mit den aktuellen Daten gefüllt. Aber beim schließen der Datei kommt die Meldung, sie sei Schreibgeschützt und ich müsste eine weitere Version quasi abspeichern.
Hast Du dazu noch eine Lösung?
Hier mal der aktuelle Code:
Public Sub ExcelExport (strViewName As String)
On Error Goto ErrorHandler
Dim session As New Notessession
Dim db As NotesDatabase
Dim view As NotesView
Dim viewColumn As NotesViewColumn
Dim viewentry As NotesViewEntry
Dim iRows As Integer
Dim iCols As Integer
Dim iColQuantity As Integer
Dim iK As Integer
Dim lDocQuantity As Long
Dim vColValues As Variant
Dim strColValue As String
Dim vExcelApp As Variant
Dim vExcelSheet As Variant
'----> Excel constants
Const xlInsideHorizontal& = 12
Const xlInsideVertical& = 11
Const xlEdgeBottom& = 9
Const xlEdgeLeft& = 7
Const xlEdgeRight& = 10
Const xlEdgeTop& = 8
Const xlContinuous& = 1
Const xlCenter& = -4108
'<----
Set db = session.CurrentDatabase
Set view = db.getview(strViewName) 'View for Excel Export
Dim vc As NotesViewEntryCollection
Set vc = view.AllEntries
lDocQuantity = vc.Count 'Number of documents in the view to Export to Excel
If lDocQuantity = 0 Then
Msgbox "Die Ansicht enthält keine Dokumente.", 64, "Excel Export abgebrochen"
Goto ExitScript
End If
Set vExcelApp = CreateObject("Excel.Application") 'Start Excel with OLE
vExcelApp.Workbooks.Open "M:\Dat_Ma\Unruh\Lotus Notes\Projekt\Dateiname.xls"
On Error Goto ErrorHandlerExcelOpen
vExcelApp.Application.ScreenUpdating = False
vExcelApp.Visible = False
vExcelApp.Workbooks.Add
vExcelApp.ReferenceStyle = 2
'---> If there are more than 1 worksheets, we delete them.
If vExcelApp.Worksheets.Count > 1 Then
vExcelApp.DisplayAlerts = False
While vExcelApp.Worksheets.Count > 1
vExcelApp.Worksheets(2).Delete
Wend
vExcelApp.DisplayAlerts = True
End If
'<----
Set vExcelSheet = vExcelApp.Workbooks(1).Worksheets(1) 'Select the first worksheet
vExcelSheet.Name = "LotusNotesExport" 'Set new worksheet name
iRows=1 'Column headings starts in row 1
iCols = 1 'Column headings starts in column 1
iColQuantity=view.ColumnCount 'How many columns in the view?
For iK=1 To iColQuantity
Set viewColumn=view.columns(iK-1)
vExcelSheet.Cells(iRows,iCols).Value = viewColumn.title
iCols = iCols + 1
Next iK
iRows=2 'Data starts in 2nd row
'---> ####### Main Code: Filling Excel with all the documents #######
'Dim pb As New LNProgressBar(True) 'Progress Bar
Set viewentry = vc.GetFirstEntry()
Do While Not (viewentry Is Nothing)
For iCols=1 To iColQuantity
vColValues=viewentry.ColumnValues(iCols-1)
'---> Implode
strColValue = AtImplode(vColValues, Chr(10))
'<--- Implode
'---> Remove square wordwrap - chars ()
While Instr ( strColValue, Chr(13) ) > 0
strColValue = Left$(strColValue, Instr ( strColValue,Chr(13) ) - 1) & "" & Right$(strColValue, Len(strColValue) - Instr ( strColValue, Chr(13) ))
Wend
'<---
vExcelSheet.Cells(iRows,iCols).Value = strColValue
Next iCols
iRows=iRows+1
Set viewentry = vc.GetNextEntry(viewentry)
Loop
'<----
'---> Format first line
Dim strSelection As String
strSelection = "A1:A" & Trim$(Str$(iColQuantity))
vExcelApp.Range(strSelection).Select 'Select first line
With vExcelApp.Selection
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.ColorIndex = 2
.Interior.ColorIndex = 47
End With
'<----
' ---> Freeze first line
vExcelApp.Range("A2").Select
vExcelApp.ActiveWindow.FreezePanes = True
'<---
' ---> Format remaining lines
strSelection = "B2:" & Chr$(65+ iRows)&Trim$(Str$(iColQuantity))
vExcelApp.Range(strSelection).Select 'select the whole data except line 1
'<---
With vExcelApp.Worksheets(1)
.PageSetup.Orientation = 2 'landscape format
'Header and footer
.PageSetup.centerheader = "&""Arial,Fett""Notes-Excel-Export from database: " + db.title +"; Extract created on: " + Format(Now,"dd/MM/yyyy HH:MM")
.Pagesetup.RightFooter = ""
.Pagesetup.CenterFooter = ""
.PageSetup.PrintTitleRows = "$1:$1" 'repeat first line on every page
End With
vExcelApp.ReferenceStyle = 1 'Set column and line - header to "A1" (and not "Z1S1")
'---> remove gridlines and set page zoom
vExcelApp.ActiveWindow.DisplayGridlines = False
vExcelApp.ActiveWindow.Zoom = 91
'<---
'---> Select all and fit column width
vExcelApp.Cells.Select
vExcelApp.Selection.Columns.AutoFit
'<----
'Finalizing.......
vExcelApp.Range("A2").Select
vExcelApp.Application.ScreenUpdating = True
vExcelApp.StatusBar = lDocQuantity & " documents successful imported ...."
vExcelApp.Visible = True
view.clear 'Clears the full-text search filtering on the view
Set vExcelApp=Nothing 'stop OLE
Set db=Nothing
ExitScript:
Exit Sub
ErrorHandler:
Call ErrorMessage("ExcelExportLib: Sub ExcelExport")
Resume ExitScript
ErrorHandlerExcelOpen:
vExcelApp.DisplayAlerts = False
vExcelApp.Quit
Call ErrorMessage("ExcelExportLib: Sub ExcelExport")
Resume ExitScript
End Sub
-
Du hast noch ein Workbooks.Add in deinem Code. Dadurch wird eine neue Arbeitsmappe erstellt.
...
On Error Goto ErrorHandlerExcelOpen
vExcelApp.Application.ScreenUpdating = False
vExcelApp.Visible = False
vExcelApp.Workbooks.Add
vExcelApp.ReferenceStyle = 2
...
Axel
-
Aber wenn ich das rausnehme, öffnet sich eine schreibgeschützte Datei, die anscheinend auch neu ist, da es nicht die von mir angelegte Datei ist.
-
Versuch's mal so:
...
Set vExcelApp = CreateObject("Excel.Application") 'Start Excel with OLE
vExcelApp.Workbooks.Open "M:\Dat_Ma\Unruh\Lotus Notes\Projekt\Dateiname.xls"
Set vExcelSheet = vExcelApp.Workbooks(1).Worksheets(1) 'Select the first worksheet
...
oder so:
...
Set vExcelApp = CreateObject("Excel.Application") 'Start Excel with OLE
vExcelApp.Workbooks.Open "M:\Dat_Ma\Unruh\Lotus Notes\Projekt\Dateiname.xls"
Set vExcelSheet = vExcelApp.ActiveWorkbook.Worksheets(1) 'Select the first worksheet
...
Die Zuweisung Set vExcelSheet = ... weiter unten im Code musst du dann auskommentieren oder löschen.
Axel
-
Das klappt toll. Kein Schreibgeschützt mehr.
Aber er überschreibt mir meine Datei.
Die vorgefertigte Datei hat mehrere Arbeitsblätter, in denen auf das erste Arbeitsblatt mit den Notes-Daten zurückgegriffen wird, zwecks Berechnungen.
Nun wird zwar diese Datei angesprochen und die Daten übertragen, aber alles andere ist weg.
Vorher (als es schreibgeschützt geöffnet wurde) war es wenigstens genau meine "Vorlage".
-
Oh, ich hab die Stelle selber gefunden. Da war nochein "Wenn es mehr als ein Arbeitsblatt gibt, lösch alle anderen" drin...
Vielen,vielen lieben Danke für die super tolle Hilfe!
Und schönes Wochenende!