lockingAccess表以防止在某些时候写入

我正在做一个每周预测,其中人们将在Excel中有一个模板来input数据。 一旦他们input了所有的数据,他们就可以在Excel中点击一个button,将数据放入Access数据库中的表格中。

在星期五上午10:30,我想把表格锁住,这样人们就有很难把数据存入数据库。 在那个时候,那个星期的预测是最终的,然后我希望在星期五的下午5点之后能够再次写入数据库(不再被locking)。

这可能吗? 即使可能有一个单独的button,我可以点击自己在上午10:30,将locking表,然后我可以再次点击它在5PM,使其解锁表(或一个单独的button)。 另外我怎样才能够使一个消息框,只有当表被locking,以告诉用户截止date已经发生,并没有更多的写入表中的消息框?

我用于从Excel模板中将数据注入到Access数据库表中的代码是:

Sub ADOFromExcelToAccess() If MsgBox("This Button Will Submit all Data in the Table to the Right & Clear the Table! Are you sure?", vbYesNo) = vbNo Then Exit Sub ' exports data from the active worksheet to a table in an Access database ' this procedure must be edited before use Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long ' connect to the Access database Set cn = New ADODB.Connection cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; " & _ "Data Source=DatabasePath;" ' open a recordset Set rs = New ADODB.Recordset rs.CursorLocation = adUseClient rs.Open "Forecast_Items", cn, adOpenKeyset, adLockBatchOptimistic, adCmdTable ' all records in a table On Error GoTo transerror cn.BeginTrans r = 17 ' the start row in the worksheet Do While Len(Range("D" & r).Formula) > 0 ' repeat until first empty cell in column D table With rs .AddNew ' create a new record ' add values to each field in the record .Fields("UserName") = Range("B" & r).Value .Fields("Forecast_Date") = Range("C" & r).Value .Fields("Area") = Range("D" & r).Value .Fields("Description_Item") = Range("E" & r).Value .Fields("Account") = Range("F" & r).Value .Fields("RRDD") = Range("G" & r).Value .Fields("CostCenter") = Range("H" & r).Value .Fields("Fleet") = Range("I" & r).Value .Fields("ForecastAmount") = Range("J" & r).Value .Fields("PlanAmount") = Range("K" & r).Value .Fields("VarianceForecast") = Range("L" & r).Value .Fields("Explanation") = Range("M" & r).Value ' add more fields if necessary... End With r = r + 1 ' next row Loop rs.UpdateBatch 'injects full table from excel into access at the same time, eliminating possible errors with inserting certain rows over others cn.CommitTrans 'makes sure that there were no errors before sending off all of the data rs.Close Set rs = Nothing cn.Close Set cn = Nothing MsgBox ("Data was Submitted Successfully! A copy of your submitted data is on tab Submitted Information") ActiveSheet.Unprotect "password" Sheets("Forecast Form").Select Range("B16:M100").Select Application.CutCopyMode = False Selection.Copy Sheets("Submitted Information").Select Range("A1").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Sheets("Forecast Form").Protect Password:="password", DrawingObjects:=False, AllowFormattingCells:=True Sheets("Forecast Form").Range("D17:M100").ClearContents Exit Sub transerror: cn.RollbackTrans rs.Close Set rs = Nothing cn.Close Set cn = Nothing MsgBox ("Required Fields are: Area/Description Item/Fleet (Use Drop Down Box to Find Appropriate Naming or N/A)/Forecast Amt/Plan Amt/Variance Amt/Explanation."), , "Data Input Error" MsgBox ("Data Was Not Submitted"), , "Data Input Error" End Sub 

至于locking表的问题,在Access中打开一个表单,用Timer事件检查date和时间来locking和解锁。 使用表上的事务locking:

 Workspaces(0).BeginTrans CurrentDB.Execute "Update MyTable SET MyField=MyField & ''" 

通过回滚此事务解锁:

 Workspaces(0).Rollback 

这可以在Access中实现而无需更改Excel代码,更新locking的表将导致错误。

如果计时器事件从Access中的表中获取它的locking和解锁时间,则Excel中的error handling程序可以创build一个指向此表的链接,并检查锁是由于时间还是实现的,或者是其他错误。基于此,你可以创build你的消息。

我看到您目前正在使用旧的Jet.OLEDB提供程序,但是如果您将数据库文件升级到Access 2010或更高版本的.accdb(并使用ACE.OLEDB或ACE ODBC),则可以创build一个Before Change 数据macros锁表:

BeforeChange.png

.OpenRecordSet有一个dbDenyWrite参数。 我不确定在这种情况下是否适用,但可能会使您走上正确的道路。 至于时间间隔,还有另外一个问题可能有助于编写关于何时自动locking表格的规则。 链接

韦恩的评论关于pipe理表来存储当前locking状态将允许您使消息框。

AFAIK,如果您在代码:CODE中使用DAOlogging集打开表

设置r = CurrentDB.OpenReocrdset(SomeTable,dbOpenTable,dbDenyRead)

只需使用Windows任务计划程序运行这个简单的脚本。 以下是描述如何安排任务的链接。

http://windows.microsoft.com/en-us/windows/schedule-task#1TC=windows-7