Auf bestimmte Exceldatei zugreifen

[Wiesel]

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

[Glombi]

Call vExcelApp.Workbooks.Open ("Laufwerk:\Verzeichnis\Dateiname.xls")

sollte es tun

Andreas

[Wiesel]

Funktioniert leider nicht. Da gibts eine Fehlermeldung an einer späteren Stelle im Code.

[Glombi]

Verräts Du uns denn auch welche Meldung an welcher Stelle kommt? Vielleicht mal den Debugger einschalten!

Andreas

[Wiesel]

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

[Axel]

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

[Wiesel]

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???

[Axel]

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

[Wiesel]

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

[Axel]

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

[Wiesel]

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.

[Axel]

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

[Wiesel]

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".

[Wiesel]

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!