为什么我在CreateQueryDef指令后无法打开表单?

时间:2018-06-19 08:47:04

标签: sql ms-access runtime-error ms-access-2016 openform

我有一个Access 2016数据库,它使用表单来选择1天或更多天的时间间隔。 通过一个按钮,我可以获得间隔的开始和结束日期,并执行以下两项操作:

a)构建一个查询,根据日期从表中提取数据集

b)打开一个弹出窗体,显示查询提取的数据集。 OpenForm事件没有代码。

神奇的是,在我使用命令

禁用Shift Bypass键之前,一切都像魅力一样
CurrentDb.Properties("AllowBypassKey") = False

之后查询仍然运行良好,但是当代码尝试打开表单时,95%的时间,我得到错误'2501 OpenForm操作被取消',即使它与Access 2013一起运行良好。< / p>

代码非常简单,但经过3天的努力,我仍然不明白出了什么问题。我唯一得到的是,如果我不执行CreateQueryDef指令,则错误消失,表单会立即打开(即使它没有显示正确的数据集)。 因此,这两个例程都是单独工作的,但如果它们一个接一个地运行则会发生冲突。

按钮后面的代码下方:

Private Sub Cmd_Meteo_Click()
On Error GoTo Err

Dim strFrmName As String                            
Dim datBegin As Date                               
Dim datEnd As Date                                 

'Set the time interval
datBegin = Me.Txt_BeginTreatment                    'Set the begin of the interval
datEnd = Me.Txt_Data                                'Set tha end of the interval

'Build the query with meteo data
Call GetMetoData(Me.Txt_Region, Me.Cmb_MeteoStation, datBegin, datEnd, False)

'Set the form name
strFrmName = "Frm_DatiMeteoControllo"                   

'Check if the form is already open
If CurrentProject.AllForms(strFrmName).IsLoaded Then        'If the form is already open
    DoCmd.Close acForm, strFrmName                          'Close the form
End If

DoCmd.OpenForm strFrmName         'This line rise the 2501 error!

Exit_sub:
    Exit Sub

Err:
    MsgBox Err.Number & " " & Err.Description
    Resume Exit_sub
End Sub

和构建查询的子例程:

Public Sub GetMetoData(strRegion As String, intIdSM As Integer, datBegin As Date, datEnd As Date, bolTot As Boolean)
On Error GoTo Err

Dim db As DAO.Database
Dim strDbName As String
Dim qdf As DAO.QueryDef
Dim strSqlMeteo As String
Dim strLinkName As String
Dim strQryName As String

Set db = CurrentDb                                  'Set the db
strDbName = Application.CurrentProject.Name         'Get the db name
strTblName = GetMeteoTableName(strRegion, intIdSM) 'Get the name of the data table
strLinkName = "Tbl_DatiMeteo"                       'Set the name of the linked table
strQryName = "TmpQry_DatiMeteoControllo"            'Set th name of the query

'SQL statement for the query
strSqlMeteo = "SELECT " & strLinkName & ".Data, ([" & strLinkName & "].[Precipitazione]) AS PrecTot, " & _
                strLinkName & ".Tmin, " & strLinkName & ".Tmean, " & strLinkName & ".Tmax" & vbCrLf & _
                "FROM " & strLinkName & vbCrLf & _
                "WHERE (((" & strLinkName & ".Data) Between #" & Format(datBegin, "mm/dd/yyyy") & "# And #" & Format(datEnd, "mm/dd/yyyy") & "#));"

'Delete the previous query
If QueryEsiste(strDbName, strQryName) Then      'If the query already exist...
    DoCmd.DeleteObject acQuery, strQryName      'delete the query.
End If

'Make the new query
Set qdf = db.CreateQueryDef(strQryName, strSqlMeteo)

Exit_sub:
    qdf.Close
    Set qdf = Nothing

    db.Close
    Set db = Nothing

    Exit Sub

Err:
    MsgBox Error$
    Resume Exit_sub
End Sub

有人有提示或遇到同样的问题吗?

1 个答案:

答案 0 :(得分:0)

没有理由删除查询:

If QueryEsiste(strDbName, strQryName) Then 
    ' Modify the previous query.
    Set qdf = db.QueryDef(strQryName)
    qdf.SQL = strSqlMeteo
Else
    ' Create the new query.
    Set qdf = db.CreateQueryDef(strQryName, strSqlMeteo)
End If