Set Excel workbook from Access

Anonym

Hallo community,

aus Access heraus möchte ich eine Excel Tabelle Aktivieren. Öffnen der Tabelle funktioniert problemlos, wenn ich aber die Tabelle, die im Hintergrund ist, wieder aktivieren und sichtbar machen möchte beiße ich mir die Zähne aus.

Dim Ret 

Dim ExcelApp As Object 

Dim WB As Workbook 

Dim TargetWorkbook As Workbook 

Set ExcelApp = CreateObject("Excel.Application")

'Check if workbook is open**********************************************************************

Ret = IsWorkBookOpen("C:/TDB\_DataBase/Process\_Data\_Analysis.xlsm") 

If Ret = True Then 

 '   ExcelApp.Visible = True 

    Set TargetWorkbook = ExcelApp.Workbooks("C:/TDB\_DataBase/Process\_Data\_Analysis.xlsm")   &lt;== Her tritt der Fehler auf , Laufzeitfehler 9 Subscript out of range. 

 '   Workbooks("Process\_Data\_Analysis.xlsm").Activate 

 '   MsgBox "The name of the active workbook is " & ActiveWorkbook.Name 

 '    Workbooks("Process\_Data\_Analysis.xlsm").Visible = True

' Set TargetWorkbook = ExcelApp.Workbooks.Open("C:/TDB_DataBase/Process_Data_Analysis.xlsm")

' ExcelApp.Visible = True

' TargetWorkbook.Worksheets("Source").Range("A2").CopyFromRecordset rsEPRT

    GoTo 700 

Else 

    Set TargetWorkbook = ExcelApp.Workbooks.Open("C:/TDB\_DataBase/Process\_Data\_Analysis.xlsm") 

    ExcelApp.Visible = True 

    TargetWorkbook.Worksheets("Source").Range("A2").CopyFromRecordset rsEPRT 

End If

Laufzeitfehler deutet auf Fehler im Filenamen hin aber der ist korrekt und wenn ich prüfe ob der File offen ist, dann funktioniert das mit dem Filenamen anstandslos, auch wenn ich den File öffne dann funktioniert das mit dem Filenamen. Das Problem taucht nicht nur bei der Kommandozeile "Set TargetWorkbook..........." auf sondern auch bei den nachfolgenden Kommandos " Workbooks....Activate" und "Workbooks.visible......" ich schaffe es einfach nicht, die offene Exceltabelle im Vordergrund sichtbar werden zu lassen. Kann mir bitte jemand auf die Sprünge helfen??

Danke

Peter

Gesperrte Frage. Diese Frage wurde aus der Microsoft-Support-Community migriert. Sie können darüber abstimmen, ob sie hilfreich ist, aber Sie können keine Kommentare oder Antworten hinzufügen oder der Frage folgen.

0 Kommentare

16 Antworten

Anonym

2022-03-26T08:51:25+00:00

Hallo Peter,

hatte ich schon gemacht.

Danke, Gruss

Peter
War diese Antwort hilfreich?

0 Kommentare Keine Kommentare
Anonym

2022-03-26T08:22:20+00:00

Hallo,

Ich sehe gerade, dass beim Aufräumen am Ende das Recordset nicht geschlossen wird. Der Code sollte so lauten:

rsEPRT.Close

Set rsEPRT = Nothing.

Fehlt das Schliessen, wird Access nach ausreichend Aufrufen abstürzen. Ich hab das Posting mit der Lösung entsprechend geändert.

Gruss - Peter
War diese Antwort hilfreich?

0 Kommentare Keine Kommentare
Anonym

2022-03-26T08:09:42+00:00

Hallo Peter,

vielen Dank für deine Hilfe, alles läuft jetzt wie ich das wollte.

Danke und Gruss

Peter
War diese Antwort hilfreich?

0 Kommentare Keine Kommentare

Anonym

Hallo,

Hast du meine letzte Antwort gelesen? Ich schrieb "Ersetzen", nicht hinzufügen. ;-)

.Worksheets("source").Activate '<== diese Zeile löschen

.Sheets("source").Select

.Sheets("source").Range("A2").CopyFromRecordset rsEPRT

Hier nochmal der komplette Code, auch für die Nachwelt:

 Sub YYIsWorkBookOpen(FileName As String) 
    Dim Db As DAO.Database 
    Dim rsEPRT As DAO.Recordset 
    Set Db = Application.CurrentDb 

    Set rsEPRT = Db.OpenRecordset("qry_Process_Data_Abfrage_Export", dbOpenDynaset) 

    Dim ExcelApp As Object 
    Dim I As Long 

    On Error Resume Next
    Set ExcelApp = GetObject(, "Excel.Application") 
    On Error GoTo 0 

    If ExcelApp Is Nothing Then 
        Err.Clear 
        Set ExcelApp = CreateObject("Excel.Application") 
        'ExcelApp.Visible = True 
        ExcelApp.WorkBooks.Open FileName:="C:\TDB_DataBase\Process_Data_Analysis.xlsm"
    Else 
        Debug.Print ExcelApp.Workbooks.Count 
        For I = 1 To ExcelApp.Workbooks.Count 
            If ExcelApp.Workbooks(I).Name = "Process_Data_Analysis.xlsm" Then 
                ExcelApp.Workbooks(I).Activate 
                Exit For 
            End If 
        Next I 
    End If 

    With ExcelApp 
        .Visible = True 
        .Sheets("source").Select 
        .Sheets("Source").Range("A2").CopyFromRecordset rsEPRT 
        .UserControl = True 
    End With 

    Set ExcelApp = Nothing 
    rsEPRT.Close
    Set rsEPRT = Nothing 
    Set Db = Nothing 

End Sub

Ich habe über die Bugfixes hinaus den redundanten .Visible entfernt und .UserControl nach hinten gesetzt. Außerdem wird das Workbook geöffnet, falls Excel erst gestartet werden muss.

Der Code sollte so funktionieren.

Gruss - Peter

0 Kommentare

Anonym

Hallo Peter,

das Thema ist immer noch nicht ausgestanden. Der Code sieht z.Zt. so aus:

Sub YYIsWorkBookOpen(FileName As String)

Dim Db As DAO.Database 

Dim rsEPRT As DAO.Recordset 

Set Db = Application.CurrentDb 

Set rsEPRT = Db.OpenRecordset("qry\_Process\_Data\_Abfrage\_Export", dbOpenDynaset) 

Dim ExcelApp As Object 

Dim I As Long 

Set ExcelApp = GetObject(, "Excel.Application") 

On Error GoTo 0 

If ExcelApp Is Nothing Then 

    Err.Clear 

    Set ExcelApp = CreateObject("Excel.Application") 

    ExcelApp.Visible = True 

Else 

    Debug.Print ExcelApp.Workbooks.Count 

    For I = 1 To ExcelApp.Workbooks.Count 

        If ExcelApp.Workbooks(I).Name = "Process\_Data\_Analysis.xlsm" Then 

            ExcelApp.Workbooks(I).Activate 

            Exit For 

        End If 

    Next I 

End If 

With ExcelApp 

    .Visible = True 

    .UserControl = True 

    .Worksheets("source").Activate            &lt;=== Fehlermeldung hier.

    .Sheets("source").Select 

    .Worksheets("Source").Range("A2").CopyFromRecordset rsEPRT 

End With 

Set ExcelApp = Nothing 

Set rsEPRT = Nothing 

Set Db = Nothing 

End Sub

Die Fehlermeldung erscheint bei: .Worksheets("source").Activate mit der nervigen Meldung : Subscript out of range.

0 Kommentare