執行 VBA 後，我失去了對數據庫的獨占訪問權限

我編寫了一些 VBA 來輕鬆地將 Excel 電子表格導入到我的數據庫中的表中。這樣，使用者只需點擊表單上的按鈕，並回答有關要導入的文件的一些問題。問題是在導入完成後，我嘗試修改數據庫中的任何其他內容，並顯示消息“您目前沒有對數據庫的獨占訪問權限。如果您繼續進行更改，您可能以後不能救他們了。” 然後我必須退出數據庫並重新打開它以進行任何更改。我以前在其他版本的 Access 上這樣做過，沒有問題。所以我不知道我是否在某個地方有錯字，或者從 Access 2013 到 2016 的某些內容髮生了變化，從而導致了問題。目前，數據庫位於我的本地機器上。最終，這將被移動到 SharePoint 站點並拆分為 2 個訪問文件。在我讓它大部分工作之前我不想這樣做，因為我沒有任何地方可以上傳到 SharePoint，而沒有很多人可以訪問它。

Private Sub ImportNewTB_Click()
On Error GoTo ImportNewTB_Click_Err 'If an error occurs anywhere along the way, make sure you still clean up the memory before quiting

Dim OwssvrFile As DAO.Database 'This is the open connection to the file
Dim OwssvrInfo As DAO.Recordset 'This is the recordset for the teachers information
Dim fileName As String 'This is the name of the file being opened
Dim dbs As DAO.Database
Dim CurrentTBDB As DAO.Recordset 'This is to make a connection to our current table
'Dim ExcelHdrs(0 To 20) As Variant 'This is an Array with the headers from the Excel file.
Dim numRecords As Integer
Dim WksName As String
Dim TimeStamp As Date

fileName = getOpenFile() 'Use the function I built in the Module
If fileName = "" Then GoTo ImportNewTB_Click_Exit 'If they didn't select anything, then just give up on life and exit

WksName = InputBox("Enter the name of the worksheet: ", "Worksheet Name", "owssvr")
numRecords = InputBox("Enter the number of records in the Worksheet: ", "Num Records", 2412)
WksName = WksName & "$A1:BE" & numRecords + 1

'Once we have a real file, open it already
Set OwssvrFile = OpenDatabase(fileName, False, True, "Excel 12.0; HDR=YES;")
'Create Recordset from the excel file.
Set OwssvrInfo = OwssvrFile.OpenRecordset(WksName)
OwssvrInfo.MoveFirst 'Goto the first line of the recordset

Set dbs = CurrentDb
Set CurrentTBDB = dbs.OpenRecordset("SELECT * FROM CurrentTB")

TimeStamp = Now()

Do
   With CurrentTBDB
       .AddNew
       .Fields!EntryDate = TimeStamp
       .Fields!ProjectName = OwssvrInfo.Fields(0)

       .Update
   End With

   OwssvrInfo.MoveNext 'All of that for entry 1, only 2000 more lines to go
Loop Until OwssvrInfo.EOF

' Tidy up, This closes everything out and releases the memory
ImportNewTB_Click_Exit:
On Error Resume Next 'Basically this says, if there's an error, I don't care, do this anyway
MsgBox "Input Complete!"
OwssvrInfo.Close
OwssvrFile.Close
CurrentTBDB.Close
Set CurrentTBDB = Nothing
Set dbs = Nothing
Set OwssvrInfo = Nothing
Set OwssvrFile = Nothing
Exit Sub

ImportNewTB_Click_Err: 'This produces an error message if one exists
MsgBox Err.Number & " " & Err.Description, vbCritical, "Error!"
Resume ImportNewTB_Click_Exit 'Make sure we still clean up before leaving
End Sub

長話短說…執行壓縮和修復。我以為我已經嘗試過了。也許我在閱讀 Scott 的文章之前就已經知道了。但是在修復它然後執行壓縮和修復之後，一切都按照它應該的方式工作。在我完成更多工作之前，我通常不必第一次在數據庫上這樣做，我猜是因為這個數據庫有接近兩萬個條目，而我使用的大多數條目更少然後 1000，它會產生巨大的差異。學過的知識。一直在學習，一直在成長。

引用自：https://dba.stackexchange.com/questions/171672