连接关闭后复制DB的权限被拒绝

时间:2014-12-12 04:29:54

标签: vba ms-access database-connection adodb

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

我相信我几乎在那里,但我遇到了问题。

在我连接之前,我似乎可以复制我的数据库没问题。 在我的连接期间(这是有意义的)或在我关闭连接后,我不再像以前那样复制和粘贴数据库。

我非常确定有一个幻像引用连接(但现在已关闭)的数据库仍然在我的代码中的某处,在我第一次运行代码时我得到了第二个副本上的错误并粘贴但是之后该错误会跳转到第一个副本并粘贴。直到我关闭访问并重新打开它。此时,错误将返回到第二个副本并粘贴。

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

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

代码示例

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

感谢您花时间阅读并思考这个问题。

编辑:我刚注意到我从未提及错误发生在哪一行。 第二次在线路上调用Sub DuplicateDB时发生错误

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

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

1 个答案:

答案 0 :(得分:0)

更改我的con.open
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 & ";"

现在似乎工作了。