Vba ошибка 3021

I am trying to export multiple datasets to the respective new Excel file.

   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:Users807140Downloads" & 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

But I get the Runtime Error 3021 — No Current Record

I substituted the

oSheet.Range("A2").CopyFromRecordset rs2
oBook.SaveAs "C:Users807140Downloads" & rs2.Fields("CostCentre") & ".xlsx"

with

Debug.Print .RecordCount

And I do actually get the appropriate record count for rs2.

How can I fix my code to eliminate the error?

Community's user avatar

asked Jul 28, 2016 at 16:27

Eliseo Di Folco's user avatar

2

Don’t use For..Next loops with Recordsets. Use this:

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

And as Ryan wrote, Dim don’t belong into any loop, move them to the start of the sub.

If this doesn’t help, please tell us on which line the error occurs.

answered Jul 28, 2016 at 16:45

Andre's user avatar

AndreAndre

26.5k6 gold badges35 silver badges80 bronze badges

1

The 3021 error («No current record.») occurs at the second of these two lines:

oSheet.Range("A2").CopyFromRecordset rs2
oBook.SaveAs "C:Users807140Downloads" & rs2.Fields("CostCentre") & ".xlsx"

That happens because the rs2 recordset pointer is at EOF after you do CopyFromRecordset rs2. Then at SaveAs, you ask for rs2.Fields("CostCentre"), but there is no available record («no current record») when the recordset pointer is at EOF.

However the rs1.Fields("CostCentre") value you used as the query parameter when opening rs2 is still accessible. So you can make the error go away by asking for rs1.Fields("CostCentre") instead of rs2.Fields("CostCentre")

oBook.SaveAs "C:Users807140Downloads" & rs1.Fields("CostCentre") & ".xlsx"

answered Jul 28, 2016 at 20:50

HansUp's user avatar

HansUpHansUp

95.7k11 gold badges76 silver badges135 bronze badges

1

This code has a few issues pointed out by @Andre and Ryan.

You’re not reusing your Excel object, you’re re-dimming objects that should only be defined once, using a With that never gets referenced so it just adds to code with no benefit.

You’re also creating a parameter query on the fly in code — instead of creating it in SQL and saving it to be reused by name.

You can try this rewritten code and see if it works better for you. I do believe that a predefined query is the better way to go — and then I’d close the query inside the loop and reset it at the start each time. I’ve just seen weird stuff happen when querydefs are reused inside loops without resetting them.

Anyways give this a try — and report on specific line that causes error

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:Users807140Downloads" & 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

answered Jul 28, 2016 at 17:09

dbmitch's user avatar

dbmitchdbmitch

5,3614 gold badges24 silver badges38 bronze badges

7

  • Remove From My Forums

 locked

Updating recordset — error 3021 — no current record

  • Question

  • Fellow developers,  I am using Access 2010

    I inherited some code for in an existing app — for updating. Normally I write direct sql but current code is doing below. All of this in in Access 2010 vba. The mykeyid is captured after we do an insert to create a user records in the beginning of the app.
    This has been working flawleslly for weeks — hit about 100 times per day without error.

    Here is the code

    mysql = «Select * from myAgentTable where keyid =» & mykeyid

    set myrs = mydb.openrecordset(mysql, dbopdbOpenDynaset)

    With myrs

                .Edit
                .Fields(«EndDate»).Value =Now()

    End With

    myrs.Update 
    myrs.close

    mydb.close

    This code has been working flawlessly for weeks. Today, I saw too cases where my error handler bubled up a 3021. No current record.  And that is pretty much impossible. When the app opens we insert the record for the key, when they close we update that
    record using the identity value key.  There record IS in the db. I have solid error handles on «every» db call.

    Is there something wrong with they type of recordset we are using for this or is there another locking option we could try. As you know, finding somethign that happens rarely is very difficult becasue we cannot get this to happen all of the time.

    Thanks for any suggestions.

    MG

Answers

  • Hi Celieste,

    It has not occurred since, we have additional traps put in to see if the values is coming back as zero. So far, nothing yet.

    • Proposed as answer by

      Tuesday, September 6, 2016 1:19 AM

    • Marked as answer by
      Chenchen Li
      Wednesday, September 7, 2016 5:43 PM

I’m writing a function in Excel VBA which will be called to extract data from an Access database, I’m using ADO connection. The function Get_g_gtop has parameters defined as bellow. Now, I try to use a command object to get the value from recordset, however, I got the error message 3021 : Either BOF or EOF is true, or current record has been deleted. Requested operations requires a current record. The debug points to the line : Get_g_gtop = rst.Fields(0).Value.

Is there anything wrong with the SQL statement to query in Access? Any advice would be highly appreciate!

Bing

Function Get_g_gtop(ByVal VehType As String, ByVal Speed As Single) As Variant

Dim Dbfilepath As String

Dbfilepath = "C:UsersseveniceDesktopEM Database.accdb"

Set cnn = New ADODB.Connection

cnn.Open "Provider= Microsoft.ACE.OLEDB.12.0;" & " Data Source=" & Dbfilepath & ";" & "Persist Security Info =False;"

'Set rst = New ADODB.Recordset

Set cmd = New ADODB.Command
cmd.ActiveConnection = cnn

'Dim QueryStr As String
Dim S As Single

If StrComp(VehType, "LDV") * StrComp(VehType, "LDT") * StrComp(VehType, "LHD<=14K") * StrComp(VehType, "LHD<=19.5K") = 0 Then
   S = 35.6
   'QueryStr = "SELECT [g/gtop] FROM [EM Database].[N (t) Data] WHERE [Vehicle Category]= "" & VehType & "" AND S = 35.6 " & " AND [Speed Lower] <= " & Speed & " AND [Speed Upper] >= " & Speed & ";"

   cmd.CommandText = "SELECT [g/gtop] FROM [EM Database].[N (t) Data] WHERE [Vehicle Category]= "" &  VehType & "" AND S = 35.6 " & " AND [Speed Lower] <= " & Speed & " AND [Speed Upper] >= " & Speed & ";"
   'rst.Open QueryStr, cnn

   Set rst = cmd.Execute

   Get_g_gtop = rst.Fields(0).Value

ElseIf StrComp(VehType, "MHD") * StrComp(VehType, "HHD") * StrComp(VehType, "Urban Bus") = 0 Then
   S = 26.7
   QueryStr = "SELECT [g/gtop] FROM [EM Database].[N (t) Data] WHERE [Vehicle Category]=" & VehType & " AND S = 26.7 " & " AND [Speed Lower] <= " & Speed & " AND [Speed Upper] >=" & Speed & ";"
   rst.Open QueryStr, cnn
   Get_g_gtop = rst.Fields(0).Value

End If

End Function

zvs

0 / 0 / 0

Регистрация: 04.11.2012

Сообщений: 56

1

10.12.2013, 16:03. Показов 4831. Ответов 5

Метки нет (Все метки)


Студворк — интернет-сервис помощи студентам

Здравствуйте!
Моя программа записывает данные в таблицу исходя из запроса с параметрами. Все работает до тех пор пока на параметр-дату( D1)нет записи…ошибка-3021…
Мне нужно при этой ошибке в таблицу rst.Fields(2)…rst.Fields(12) прописать 0 и перейти к следующей процедуре…
Часть програмы

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
gl = "qrtGL1VALL"
    Set zap1 = DB.QueryDefs(gl)
    
        IF NOT rst2.BOF THEN
        rst2.MoveFirst
        
          DO UNTIL rst2.EOF
         IF rst2![P] = -1 THEN
        S = rst2![ICCODE]
     
    zap1.Parameters("Par1") = D1
    zap1.Parameters("Par2") = "P"
    zap1.Parameters("Par3") = S
    zap1.Parameters("Par4") = T
    Set BE = zap1.OpenRecordset()
 
    rst.AddNew
    rst.Fields(0).Value = "BBI"
    rst.Fields(1).Value = D1
    rst.Fields(2).Value = BE.[ICCODE].Value
    rst.Fields(3).Value = BE.[ELTCODE].Value
    rst.Fields(9).Value = BE.NN.Value
    rst.Fields(10).Value = BE![NNEL].Value
    'rst.Fields(11).Value = be.[Iso].Value
    rst.Fields(12).Value = BE.[NNIS].Value
    rst.Fields(13).Value = "BOOK BEGINNING"
    rst.Fields(14).Value = BE.[UNI].Value
   
    rst.Update
    BE.CLOSE



0



mobile

Эксперт MS Access

26784 / 14463 / 3192

Регистрация: 28.04.2012

Сообщений: 15,782

10.12.2013, 16:44

2

Цитата
Сообщение от zvs
Посмотреть сообщение

Все работает до тех пор пока на параметр-дату( D1)нет записи…ошибка-3021…
Мне нужно при этой ошибке в таблицу rst.Fields(2)…rst.Fields(12) прописать 0 и перейти к следующей процедуре…

Поскольку неясно куда надо переходить и в каком месте кода проверять отсутствие данных, то скажем так:
перед rst.AddNew пишем проверку D1 и если NULL, обходим цикл записи

Visual Basic
1
2
3
4
5
If Len(D1 & "")=0 Then Goto МеткаОбойти
rst.AddNew
...........
rst.Update
МеткаОбойти:



1



zvs

0 / 0 / 0

Регистрация: 04.11.2012

Сообщений: 56

11.12.2013, 12:38

 [ТС]

3

Цитата
Сообщение от mobile
Посмотреть сообщение

Поскольку неясно куда надо переходить и в каком месте кода проверять отсутствие данных, то скажем так:
перед rst.AddNew пишем проверку D1 и если NULL, обходим цикл записи

Visual Basic
1
2
3
4
5
If Len(D1 & "")=0 Then Goto МеткаОбойти
rst.AddNew
...........
rst.Update
МеткаОбойти:

У меня ошибка срабатывает на rst2.MoveFirst, посколко на дату D1(дата из формы) в запросе нет записей и естественно нет первой строки…., для этого случая мне нужно таблицу на дату D1 заполнить поля нулями….(таблица используется для отчета за период)…



0



mobile

Эксперт MS Access

26784 / 14463 / 3192

Регистрация: 28.04.2012

Сообщений: 15,782

11.12.2013, 13:04

4

Цитата
Сообщение от zvs
Посмотреть сообщение

У меня ошибка срабатывает на rst2.MoveFirst, посколко на дату D1(дата из формы) в запросе нет записей и естественно нет первой строки…., для этого случая мне нужно таблицу на дату D1 заполнить поля нулями

Может быть так

Visual Basic
1
2
3
4
IF rst2.BOF and rst2.EOF THEN
   'Здесь записать в таблицу нужные данные
End If
    rst2.MoveFirst



0



Модератор

Эксперт MS Access

11391 / 4701 / 759

Регистрация: 07.08.2010

Сообщений: 13,644

Записей в блоге: 4

11.12.2013, 13:16

5

применяю только Do While rst2.EOF = False
хотя из-за вашего неполного кода нельзя понять, что куда читается -пишется
rst
rst2
be



0



zvs

0 / 0 / 0

Регистрация: 04.11.2012

Сообщений: 56

11.12.2013, 15:51

 [ТС]

6

Цитата
Сообщение от mobile
Посмотреть сообщение

Поскольку неясно куда надо переходить и в каком месте кода проверять отсутствие данных, то скажем так:
перед rst.AddNew пишем проверку D1 и если NULL, обходим цикл записи

Visual Basic
1
2
3
4
5
If Len(D1 & "")=0 Then Goto МеткаОбойти
rst.AddNew
...........
rst.Update
МеткаОбойти:

спасибо за подсказку, я ею воспользовалась…но у меня возникла другая проблема -Как правильно прописать повторяющуюся ошибку…Первый раз все правильно работает, а во второй раз не видит метки….

QBasic/QuickBASIC
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
FUNCTION glrepVZ(T, D1, D2 AS Variant)
Set DB = CurrentDb
Set rst = DB.OpenRecordset("tblGLAll", DB_OPEN_DYNASET)
     gl = "qrtGLZA"
    Set zap1 = DB.QueryDefs(gl)
     IF NOT rst.BOF THEN
        rst.MoveFirst
        DO UNTIL rst.EOF
            rst.Delete
            rst.MoveNext
        LOOP
    END IF
    zap1.Parameters("Par1") = D1
    zap1.Parameters("Par2") = "U"
    zap1.Parameters("Par3") = T
 
    Set BE = zap1.OpenRecordset()
 
    rst.AddNew
    rst.Fields(0).Value = "BBI"
    rst.Fields(1).Value = D1
     
     ON ERROR GOTO RR
 IF RR THEN
RR:
 
   rst.Fields(3).Value = "U"
    rst.Fields(9).Value = "0"
    rst.Fields(10).Value = "0"
    rst.Fields(11).Value = "0"
    rst.Fields(12).Value = "0"
   rst.Fields(13).Value = "BOOK BEGINNING"
    rst.Fields(14).Value = "G"
    rst.Update
ELSE
       rst.Fields(3).Value = BE.[ELTCODE].Value
    rst.Fields(9).Value = BE.NN.Value
    rst.Fields(10).Value = BE![NNEL].Value
    rst.Fields(11).Value = BE.[Iso].Value
    rst.Fields(12).Value = BE.[NNIS].Value
    rst.Fields(13).Value = "BOOK BEGINNING"
    rst.Fields(14).Value = BE.[UNI].Value
    rst.Update
    BE.CLOSE
    END IF
    zap1.Parameters("Par1") = D1
    zap1.Parameters("Par2") = "P"
    zap1.Parameters("Par3") = T
    Set BE = zap1.OpenRecordset()
        rst.AddNew
    rst.Fields(0).Value = "BBI"
    rst.Fields(1).Value = D1
    
          ON ERROR GOTO R ‘-(не переходит на метку R)
 IF R THEN
‘ MsgBox "R=" & R
R:
 
   rst.Fields(3).Value = "P"
    rst.Fields(9).Value = "0"
    rst.Fields(10).Value = "0"
    rst.Fields(11).Value = "0"
    rst.Fields(12).Value = "0"
   rst.Fields(13).Value = "BOOK BEGINNING"
    rst.Fields(14).Value = ""
    rst.Update
    ELSE
    rst.Fields(3).Value = BE.[ELTCODE].Value
    rst.Fields(9).Value = BE.NN.Value
    rst.Fields(10).Value = BE![NNEL].Value
    rst.Fields(11).Value = BE.[Iso].Value
    rst.Fields(12).Value = BE.[NNIS].Value
    rst.Fields(13).Value = "BOOK BEGINNING"
    rst.Fields(14).Value = BE.[UNI].Value
    rst.Update
    BE.CLOSE
  END IF



0



The MS Access error 3021 — No current record can occur when you try to modify the records in the Access database. Some users have reported encountering this error while using the Recordset object (DAO) to modify the records in the database or using VBA code to import tables. It may also occur when changing the location of the shared SysData folder from the Admin screen. The SysData folder is a directory folder on a shared network drive containing all files that are required for running FRx application.

Causes of MS Access Error 3021

There are many reasons that may cause the Access error 3021. Some possible reasons are:

  • Current record has been deleted.
  • Records in the MS Access database are corrupted.
  • Insufficient permissions to edit the file that stores the shared SysData location.
  • Mapped drive errors.
  • Wrong path to the shared SysData folder.

Solutions to Fix the MS Access Error 3021

Try the following methods to fix the MS Access error 3021 — No current record.

Method 1: Use BOF/EOF Properties to Check Records

You can get the MS Access error 3021 — No current record when you try to open an empty Recordset or if the current record has been deleted. You can’t position the current record, if the Recordset is empty. In such a case, you can check the BOF and EOF properties in a Recordset object to determine the records. If you see that the EOF or BOF property is set to True, it means that there is no record.

Note: The BOF indicates that the current record position is before the first record in a Recordset object whereas EOF indicates that the current record position is after the last record in a Recordset object.

Method 2: Check Permissions of SysData Folder

The MS Access error 3021 can occur if you do not have sufficient permissions to modify the SysData folder. You can check and set the folder permissions using the below steps:

  • Go to the folder, right-click on it, and then click Properties.

property wizard

  • In the Attribute section, check if the Read-Only checkbox is selected or not. If it is, then clear it.

folder properties for attributes

  • Click OK.
  • Now go to the Security tab and click Edit.

permissions for new folder window

  • Check that all users have Read, Read & Execute, Write, and Modifypermissions for the folder. If users are missing these permissions, add the permissions, and then click OK.

Method 3: Verify the Path of SysData Folder

The error 3021 — No current record may also occur when you try to change the location of the SysData folder using the Admin window or access the folder using the wrong path. So first check whether you are trying to access the folder from the correct location on the system. To check the path, follow these steps:

  • If there are multiple workstations, first verify all workstations have installed the same version/service pack.
  • Now go the FRx32.exe folder and edit the FRx32.cfg file in this directory using Notepad, to show the correct SysData location using the Standard UNC paths.

Caution: Do not edit the FRx32.cfg file prior to opening FRx, as this can cause loss of data in the shared SysData location.

  • Once you saved the changes to the FRx32.cfg, open FRx.

Method 4: Repair the Corrupted Database

Sometimes, the MS Access error 3021 can occur due to corrupted records in the database. In such a case, you can repair the corrupted database using Microsoft’s built-in tool — Compact and Repair. To use this tool, follow the below steps:

  • Open the desired database.
  • Select File > Info > Compact & Repair Database.

MS Access creates a copy of the compacted and repaired database at the same location.

If the Compact and Repair tool does not work or fails to repair the corrupted database, then you can use a reliable MS Access database repair tool, such as Stellar Repair for Access. This tool can repair corrupt Access database (.ACCDB and .MDB) files. It can recover all the objects of the database, such as records, macros, tables, etc. with complete integrity. The software supports Windows 11, 10, 8.1, 8, 7, Vista, 2003, and XP.

Closure

The MS Access error 3021 can occur when trying to access the records of the Access database. This error can occur due to different reasons. You can follow the methods discussed in this post to fix the error. If it occurs due to corruption, try the Compact and Repair utility in MS Access. If the utility fails to fix the issue, then use Stellar Repair for Access to repair the corrupt database file and recover all its objects

Понравилась статья? Поделить с друзьями:
  • Vba ошибка 3001
  • Vba ошибка 2501
  • Vba ошибка 2147417848
  • Vba ошибка 1004 при открытии файла
  • Vba отключить проверку ошибок