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/ (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!?
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!
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.
Hallo Markus,
vielen Dank für Deine Nachricht!!!
habe den Code jetzt so umgeändert und er läuft im Moment ohne Fehler..
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.
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 ...
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?
Hallo,
Set Bereich = appExcel.Range("A2:" & strLC)
Dim Bereich as Excel.Bereich
so hab ich es im Moment.
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 :-[
Set Bereich = appExcel.Range("A2:" & strLC)
Eine Excelinstanz hat keine Bereiche.
Saubere Referenzierung:
Instanz => Arbeitsmappe => Arbeitsblatt => Bereich/Zelle
Hallo Eberhard,
erstmal vielen Dank für Deine Hilfe.
Also muss es so sein oder?
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 .(