我有一个 Access 2016 数据库,该数据库使用表单选择 1 天或更长时间的时间间隔。 一个按钮让我获取间隔的开始和结束日期,并做以下两件事:
a( 构建一个查询,该查询基于日期从表中提取数据集
b( 打开一个弹出表单,其中显示查询提取的数据集。OpenForm 事件上没有代码。
神奇的是,一切都像魅力一样工作,直到我使用命令禁用 Shift 旁路键
CurrentDb.Properties("AllowBypassKey") = False
之后,查询仍然运行良好,但是当代码尝试打开窗体时,95% 的情况下,我收到错误"2501 OpenForm 操作已取消",即使它与 Access 2013 配合良好。
代码很简单,但是经过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
有没有人有提示或面临同样的问题?
应该没有理由删除查询:
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