连接关闭后复制DB时拒绝权限 [英] Permission denied in copying DB after connection closed

问题描述

我一直在尝试复制粘贴数据库并更改一些条目。

I've been trying to copy paste a db and change a few entries.

我相信我几乎在那里，但我遇到了一个问题。

I believe I'm almost there but I hit a problem.

似乎我可以复制我的数据库没有问题，直到我连接它。
在我的连接（这是有道理的）或在我关闭连接后，我不能再像以前一样复制和粘贴数据库。

It seems that I can copy my db no problem until I connect with it. During my connection (which makes sense) or after I close the connection I am no longer able to copy and paste the DB as I did before.

我确定有一个phantom引用连接（但现在关闭）数据库剩余在我的代码在我第一次运行的代码我得到在第二次复制和粘贴的错误，但之后错误跳转到第一次复制和粘贴。这是直到我关闭访问并重新打开它。此时，错误返回到第二次复制和粘贴。

I'm pretty sure there is a phantom reference to the connected (but now closed) db remaining somewhere in my code for on my first run through of the code I get the error on the second copy and paste but after that the error jumps up to the first copy and paste. That is until I close access and reopen it. At that point the error returns to the second copy and paste.

我希望这对某人有点意义，他们可以指出正确的方向。

I hope this makes a little sense to someone and they can point me in the right direction.

问题：如何在连接完成后清除对连接的所有引用。

Question: How do I clear all reference to a connection after I'm done with it.

代码示例

Sub Transfer()

'Connection related to DB that contains the master data
Dim ori As Object
Set ori = CreateObject("ADODB.Connection")
Dim oriLoc As String
oriLoc = "Path\RAUMain.accdb"

'Connection related to DB that will host the data.
Dim dest As Object
Set dest = CreateObject("ADODB.Connection")
Dim destLoc As String
destLoc = "Path\Mirror DB\RAUMain.accdb"

'Location and connection that the DB will duplicated and stored until sensitive data is removed
'This is to prevent the case that an error in removing sensitive data would leave the db
'in a location where people would be able to see data that they are not suppose to.
Dim temp As Object
Set temp = CreateObject("ADODB.Connection")
Dim tempLoc As String
tempLoc = "Path\tempRAUMain.accdb"

'Duplicate ori DB
Call DuplicateDB(oriLoc, tempLoc)

'Clear all Sensitive Data from tempDB
'All entries that don't have the share field
' marked as true will be stripped of sensitive data

Call ClearSensitiveData(temp, tempLoc)

'Duplicate the temp data into the destination location
Call DuplicateDB(tempLoc, destLoc)


End Sub



'Duplicates the DB so to insure all data is accurate.
Sub DuplicateDB(oriLoc As String, destLoc As String)

Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
dbFile = fso.CopyFile(oriLoc, destLoc, True)

End Sub


'Duplicates the DB so to insure all data is accurate.
Sub DuplicateDB(oriLoc As String, destLoc As String)

Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
dbFile = fso.CopyFile(oriLoc, destLoc, True)

End Sub

Sub ClearSensitiveData(ByRef con As Object, dbLoc As String)

'Connect to the DB
Call Connect(con, dbLoc)

    'Code Clear sensitive data

con.Close

'con.Quit
End Sub

Sub Connect(ByRef con As Object, ByVal Loc As String)

Loc = Loc & ";"

On Error GoTo UpdatePublicDatabase_OpenError
con.Open _
        "Driver={Microsoft Access Driver (*.mdb, *.accdb)};" & _
        "Dbq=" & Loc & _
        "Exclusive=1;" & _
        "Uid=admin;" & _
        "Pwd=;"
On Error GoTo 0

Debug.Print "Done."
Exit Sub

UpdatePublicDatabase_OpenError:
Debug.Print "Exclusive 'Open' failed. Quitting."
Exit Sub

End Sub

阅读和思考这个问题。

Thanks for taking the time to read and ponder this question.

编辑：我只是注意到我从来没有提到在哪一行发生错误。
第二次调用Sub DuplicateDB的时候发生错误

I just noticed that I never mentioned on which line the error occurs. The error happens the second time I call Sub DuplicateDB on line

dbFile = fso.CopyFile(oriLoc, destLoc, True) 

，错误是运行时错误'70'：权限被拒绝

and the error is Run-time error '70': Permission Denied

推荐答案

从

con.Open _
    "Driver={Microsoft Access Driver (*.mdb, *.accdb)};" & _
    "Dbq=" & Loc & _
    "Exclusive=1;" & _
    "Uid=admin;" & _
    "Pwd=;"

到

con.Open _
        "Driver={Microsoft Access Driver (*.mdb, *.accdb)};" & _
        "Dbq=" & Loc & ";"

现在似乎工作了。

这篇关于连接关闭后复制DB时拒绝权限的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！