Referenz richtig setzen Access auf Excel

[silentwolf]

Hallo an alle,

Ich habe leider mit folgenden Code Probleme von Access auf Excel richtig zu referenzieren.
Leider komme ich selbst nicht drauf und hab schon einige selbstversuche unternommen um hier die Lösung zu finden unteranderm unter diesem link..
https://www.mrexcel.com/board/threads/referenz-to-excel-from-access.1121243/

Tut mir leid weben dem cross posting aber ich dachte vielleicht kann mir hier jemand helfen?! Hoffe es ist nicht ein all zu großes Problem!?

Code [Auswählen] Erweitern

Sub InsertWorksheetsFromFolder()
    Dim appExcel As Excel.Application
    Dim wkbExcel As Excel.Workbook
   
    Dim strPath As String
    Dim strFileName As String
   
    Dim Bereich As Range
    Dim strLC As String
    Dim i As Integer
       
    Set appExcel = New Excel.Application
    Set wkbExcel = appExcel.Workbooks.Open("C:\Users\Silentwolf\Documents\My Data Projects\Auszugsklasse\Test.xlsm")
   
    appExcel.Visible = True
   
    appExcel.Application.ScreenUpdating = False

    strPath = "C:\Users\Silentwolf\Documents\xxx\xxxxx\2019\xxxx_2019\"
    strFileName = Dir(strPath & "*.xlsx")

    Do While strFileName <> ""
        appExcel.Workbooks.Open FileName:=strPath & strFileName, ReadOnly:=True
       
        With appExcel.ActiveWorkbook
            .Worksheets(1).Copy After:=wkbExcel.Sheets(1)
        End With
       
        appExcel.Workbooks(strFileName).Close
        strFileName = Dir()
    Loop
   
    For i = 2 To wkbExcel.Worksheets.count
        With wkbExcel.Worksheets(i).UsedRange
            strLC = .Cells(.Rows.count, .Columns.count).Address

'============================================================================

            Set Bereich = .Range("A2:" & strLC)
            Bereich.Copy Destination:=wkbExcel.Sheets("Zusammenfassung").Cells(Rows.count, 1).End(xlUp).Offset(1, 0)

'=================================================================================

        End With
    Next i
   
    appExcel.Application.ScreenUpdating = True
       
    wkbExcel.SaveAs (strPath & "\" & "Test")
   
'    Stop
   
    appExcel.Quit
    Set wkbExcel = Nothing
    Set appExcel = Nothing
   
End Sub

Das Problem ist beim Set Bereich = ........ bzw. bei der Zeile Bereich.Copy Destination.......

Danke für Eure Mühe!

[markusxy]

Fehlermeldung?

Außerdem Range solltest du nicht verwenden sondern, Excel.Range.
Das Problem ist doch, dass es eine Range Klasse auch anders wo existieren kann.

[silentwolf]

Hallo Markus,

vielen Dank für Deine Nachricht!!!

habe den Code jetzt so umgeändert und er läuft im Moment ohne Fehler..

Code [Auswählen] Erweitern

Sub InsertWorksheetsFromFolder()
    Dim appExcel As Excel.Application
    Dim wkbExcel As Excel.Workbook
    Dim wksExcel As Excel.Worksheet
   
    Dim strPath As String
    Dim strFileName As String
   
    Dim Bereich As Range
    Dim strLC As String
    Dim i As Integer
       
    Set appExcel = New Excel.Application
    Set wkbExcel = appExcel.Workbooks.Add
   
    Set wksExcel = wkbExcel.Worksheets(1)
    wksExcel.Name = "Zusammenfassung"
     
'    appExcel.Visible = True
'    appExcel.Application.ScreenUpdating = False

    strPath = "C:\Users\Silentwolf\Documents\Files\2019\Statements_2019\"
    strFileName = Dir(strPath & "*.xlsx")

    Do While strFileName <> ""
        appExcel.Workbooks.Open FileName:=strPath & strFileName, ReadOnly:=True
       
        With appExcel.ActiveWorkbook
            .Worksheets(1).Copy After:=wkbExcel.Sheets(1)
        End With
       
        appExcel.Workbooks(strFileName).Close SaveChanges:= False
        strFileName = Dir()
    Loop
   
    For i = 2 To wkbExcel.Worksheets.count
        With wkbExcel.Worksheets(i).UsedRange
            strLC = .Cells(.Rows.count, .Columns.count).Address
            Set Bereich = appExcel.Range("A2:" & strLC)
                With wkbExcel.Sheets("Zusammenfassung")
                    Bereich.Copy Destination:=wkbExcel.Sheets("Zusammenfassung").Cells(Rows.count, 1).End(xlUp).Offset(1, 0)
                End With
        End With
    Next i
       
'    appExcel.Application.ScreenUpdating = True
       
    wkbExcel.SaveAs ("C:\Users\Albert\Documents\My Data Projects\Auszugsklasse\" & "Test03")
    wkbExcel.Close
   
    appExcel.Quit
   
    Set Bereich = Nothing
    Set wkbExcel = Nothing
    Set appExcel = Nothing
   
End Sub

Momentan geht es ohne Fehlermeldung ... zuerst war noch die Fehlermeldung 462 Remote Computer...
Aber im Task Manager ist immer noch eine Excel Instanz übrig und ich weiß wirklich nicht wie ich diese aus der Prozedur schließen kann.. .. dachte mit SaveChanges:=False würe vielleicht was bewirken wenn appExcel.Visible = false oder nicht aktive ist.

[silentwolf]

Nachtrag..

Also jetzt läuft der Code wenn ich eine Instanz im Task Manager offen habe ohne Fehler.
Schließe ich diese Instanz und führe den Code nochmals aus dann bekomme ich wie gesagt den Fehler 462.. Remote Server ...

[markusxy]

In deinem Code steht aber immer noch Range statt Excel.Range.
Hast du das jetzt geändert?

Wie lautet außerdem die vollständige Fehlermeldung - du hast ja nur einen Teil davon  angeführt und taucht die beim Set Bereich auf, oder anderswo?

[silentwolf]

Hallo,

Set Bereich = appExcel.Range("A2:" & strLC)

Dim Bereich as Excel.Bereich

so hab ich es im Moment.

[silentwolf]

Also wenn ich den Code das erste mal durchlaufe ohne einer Instanz im Task Manager dann bekomme ich keine Fehler und der Code läuft durch.
Danach ist aber eine Instanz noch im Task Manager enthalten .. führe ich nun den Code das zweite mal durch bekomme ich einen Laufzeitfehler 1004: Die Methode 'Rows' für das Objekt_ Global ist fehlgeschlagen.

Bereich.Copy Destination:= wkbExcel.Sheets("Zusammenfassung").....


bei wiederholten durchlaufen also beim dritten mal ohne etwas zu beenden im Taskmanager läuft der Code wieder 

Und wenn ich nun wieder alle Excel Instanzen im Taskmanger beende und nochmals ausführe dann bekomme ich den Laufzeitfehler 462
Der Remote Server Computer exisiert nicht oder ist nich verfügbar und auch an der selben Stelle aus zuvor..

Das ist doch aus der Haut fahren 

[ebs17]

Code [Auswählen] Erweitern

Set Bereich = appExcel.Range("A2:" & strLC)
Eine Excelinstanz hat keine Bereiche.

Saubere Referenzierung:
Instanz => Arbeitsmappe => Arbeitsblatt => Bereich/Zelle

[silentwolf]

Hallo Eberhard,

erstmal vielen Dank für Deine Hilfe.

Also muss es so sein oder?

Code [Auswählen] Erweitern

    For i = 2 To wkbExcel.Worksheets.count
        With wkbExcel.Worksheets(i).UsedRange
            strLC = .Cells(.Rows.count, .Columns.count).Address
                Set Bereich = .Range("A2:" & strLC)
                With wkbExcel.Sheets("Zusammenfassung")
                    Bereich.Copy Destination:=wkbExcel.Sheets("Zusammenfassung").Cells(Rows.count, 1).End(xlUp).Offset(1, 0)
                End With
        End With
    Next i

Tut mir leid aber ich bin schon ganz durcheinander nach so vielen probieren und Fehlern .(