VBA-Laufzeitfehler 3021 - Kein aktueller Datensatz

Question

Ich versuche, mehrere Datensätze in die jeweils neue Excel-Datei zu exportieren.

Public Sub MultipleQueries() 

Dim i As Integer 
Dim Mailer As Database 
Dim rs1 As Recordset 
Dim rs2 As Recordset 
Dim qdf As QueryDef 

Set Mailer = CurrentDb 
Set rs1 = Mailer.OpenRecordset("MailerData") 
Set qdf = Mailer.CreateQueryDef("CCspl", "PARAMETERS CostCentre Text (255);SELECT MonthlyFteData.CostCentre, MonthlyFteData.EmpName, MonthlyFteData.Workload FROM MonthlyFteData WHERE (((MonthlyFteData.CostCentre)=[CostCentre]))") 

For i = 0 To rs1.RecordCount - 1 

qdf.Parameters("CostCentre") = rs1.Fields("CostCentre") 

    Dim oExcel As Object 
    Dim oBook As Object 
    Dim oSheet As Object 
    Set oExcel = CreateObject("Excel.Application") 
    Set oBook = oExcel.Workbooks.Add 
    Set oSheet = oBook.Worksheets(1) 

Set rs2 = qdf.OpenRecordset() 

With rs2 

oSheet.Range("A2").CopyFromRecordset rs2 
oBook.SaveAs "C:\Users\807140\Downloads\" & rs2.Fields("CostCentre") & ".xlsx" 

rs2.Close 
oExcel.Quit 
Set oExcel = Nothing 

End With 

rs1.MoveNext 
Next i 

qdf.Close 
Set qdf = Nothing 
rs1.Close 

End Sub 

Aber ich bekomme die Runtime Error 3021 - Kein aktueller Datensatz

ich die

substituierte

oSheet.Range("A2").CopyFromRecordset rs2 
oBook.SaveAs "C:\Users\807140\Downloads\" & rs2.Fields("CostCentre") & ".xlsx" 

mit

Debug.Print .RecordCount 

Und ich bekomme tatsächlich die entsprechende Anzahl der Datensätze für rs2.

Wie kann ich meinen Code beheben, um den Fehler zu beheben?

Answer 1

Dieser Code weist einige Probleme auf, auf die @Andre und Ryan hinweisen.

Sie verwenden Ihr Excel-Objekt nicht erneut, Sie dimmen Objekte neu, die nur einmal definiert werden sollten, wobei ein With-Objekt nie referenziert wird, sodass es nur Code ohne Nutzen hinzufügt.

Sie erstellen auch eine Parameterabfrage direkt im Code - anstatt sie in SQL zu erstellen und sie so zu speichern, dass sie mit dem Namen wiederverwendet werden kann.

Sie können diesen neu geschriebenen Code versuchen und sehen, ob es für Sie besser funktioniert. Ich glaube, dass eine vordefinierte Abfrage der bessere Weg ist - und dann würde ich die Abfrage innerhalb der Schleife schließen und jedes Mal am Anfang zurücksetzen. Ich habe gerade seltsame Sachen gesehen, wenn Querydefs in Loops wiederverwendet werden, ohne sie zurückzusetzen. („Kein aktueller Datensatz“ ) -

Anyways geben eine dieser versuchen und berichten über spezifische Linie, die Fehler verursacht

Public Sub MultipleQueries() 

    Dim i  As Integer 
    Dim Mailer As Database 
    Dim rs1  As Recordset 
    Dim rs2  As Recordset 
    Dim qdf  As QueryDef 

    Dim oExcel As Object 
    Dim oBook As Object 
    Dim oSheet As Object 

    ' Only Open and Close Excel once 
    Set oExcel = CreateObject("Excel.Application") 

    Set Mailer = CurrentDb 
    Set rs1 = Mailer.OpenRecordset("MailerData") 

    ' Ideally you'd put this create query ahead of time instead of dynamically 
    Set qdf = Mailer.CreateQueryDef("CCspl", "PARAMETERS CostCentre Text (255);SELECT MonthlyFteData.CostCentre, MonthlyFteData.EmpName, MonthlyFteData.Workload FROM MonthlyFteData WHERE (((MonthlyFteData.CostCentre)=[CostCentre]))") 

    Do Until rs1.EOF 

     ' Sometimes weird things happen when you reuse querydef with new parameters 
     qdf.Parameters("CostCentre") = rs1.Fields("CostCentre") 
     Set rs2 = qdf.OpenRecordset() 

     If Not rs2.EOF Then 
      Set oBook = oExcel.Workbooks.Add 
      Set oSheet = oBook.Worksheets(1) 

      oSheet.Range("A2").CopyFromRecordset rs2 
      oBook.SaveAs "C:\Users\807140\Downloads\" & rs2.Fields("CostCentre") & ".xlsx" 
     Else 
      Msgbox "No Data Found for: " & rs1.Fields("CostCentre") 
      Exit Do 
     End If 

     rs2.Close 

     Set rs2 = Nothing 
     Set oBook = Nothing  
     Set oSheet = Nothing   

     rs1.MoveNext 
    Loop 

    oExcel.Quit 

    qdf.Close 
    rs1.Close 
    Mailer.Close 

    Set qdf = Nothing 
    Set rs1 = Nothing 
    Set Mailer = Nothing 

    ' Remove Excel references 
    Set oBook = Nothing 
    Set oSheet = Nothing 
    Set oExcel = Nothing 

End Sub 

Answer 2

Verwenden Sie keine For..Next Schleifen mit Recordsets. Verwenden Sie diese Option:

Do While Not rs1.EOF 
    ' do stuff with rs1 
    rs1.MoveNext 
Loop 
rs1.close 

Und wie Ryan schrieb, Dim gehören nicht in jede Schleife, bewegen sie an den Anfang des Unter.

Wenn dies nicht hilft, teilen Sie uns bitte mit, in welcher Zeile der Fehler auftritt.

Answer 3

Der 3021 Fehler tritt bei der zweiten dieser beiden Linien:

oSheet.Range("A2").CopyFromRecordset rs2 
oBook.SaveAs "C:\Users\807140\Downloads\" & rs2.Fields("CostCentre") & ".xlsx" 

das geschieht, weil der rs2 Cord-Zeiger auf EOF ist ein nachdem Sie CopyFromRecordset rs2 getan haben. Dann bei SaveAs, fragen Sie nach rs2.Fields("CostCentre"), aber es gibt keinen verfügbaren Datensatz ("kein aktueller Datensatz"), wenn der Datensatzzeiger auf EOF ist. Der Wert rs1.Fields("CostCentre"), den Sie als Abfrageparameter beim Öffnen von rs2 verwendet haben, ist weiterhin verfügbar.So können Sie den Fehler machen, indem er für rs1.Fields("CostCentre") statt rs2.Fields("CostCentre")

oBook.SaveAs "C:\Users\807140\Downloads\" & rs1.Fields("CostCentre") & ".xlsx"