MSAccess崩溃打开文件

Question

我正在Windows 10 PC上使用Office 365。

我在Access中有一些VBA代码，用于检查文件是打开还是锁定（该文件在此PC上是本地的。

在一台计算机上，此代码可运行大多数文件，但是在到达一组特定文件时始终崩溃。如果我手动逐步执行代码以从第一个文件继续前进，则每次都是同一组文件。我尝试重新启动PC以清除所有锁定，但结果相同。

[当我说崩溃时，我的意思是我对Access的控制失去了控制，Windows报告它不再响应。

如果我在不同的PC上运行相同的代码，引用的是相同的文件，它将报告该文件已锁定，但不会崩溃。

文件未锁定，或者不是按照我理解的文件锁定方式。从用户界面，我可以随意重命名，移动或删除文件。

我相当确定所编写的VBA代码没有问题，并且开始认为某处可能存在损坏的DLL。

VBA参考

我的代码在Open my_source For Input Lock Read As #ff行崩溃

Function copyormovemyfiles(my_source As String, my_dest As String, mycontrol As Integer) As Boolean
Dim fso As Scripting.FileSystemObject
Dim ff As Long, ErrNo As Long
''''''''''''''''

' mycontrol = 1 for a move
' mycontrol = 2 for a copy.   It will not overwrite files

''''''''''''''''

On Error GoTo error_control

Set fso = New Scripting.FileSystemObject
If Not fso.FileExists(my_source) Then
    Err.Raise 1000, , my_source & " does not exist!" & vbExclamation & "Source File Missing"

ElseIf Not fso.FileExists(my_dest) Then        
    fso.CopyFile my_source, my_dest, True

Else
    Err.Raise 1000, my_dest & " already exists!" & vbExclamation
End If


Select Case mycontrol

Case 1
    On Error Resume Next
    ff = FreeFile()
    Open my_source For Input Lock Read As #ff
    Close ff
    ErrNo = Err
    'On Error GoTo 0
    If ErrNo > 0 Then Stop
    Err.Clear
    'Select Case ErrNo
    'Case 0:    IsWorkBookOpen = False
    'Case 70:   IsWorkBookOpen = True
    'Case Else: Error ErrNo
    'End Select

    On Error GoTo error_control

Answer 1

最好只执行一个操作，然后处理失败案例，而不要事先进行测试。原因是状态可能会在测试和操作之间发生变化。另外，当您可以让您的代码自然地将其引发错误时，您将手动引发错误。

所以您说您的副本不会被覆盖，但是您告诉copy命令要覆盖。如果我们告诉它不要覆盖，那么我们就不再需要测试源或目标是否存在，它们都会导致明显的错误。

注意：不要在变量或函数名称中使用下划线“ _，因为它们用于VBA事件处理程序中的事件定义。

Function copyormovemyfiles(my_source As String, my_dest As String, mycontrol As Integer) As Boolean
    ''''''''''''''''
    ' mycontrol = 1 for a move
    ' mycontrol = 2 for a copy.   It will not overwrite files
    ''''''''''''''''
    On Error GoTo error_control
    Dim fso As Scripting.FileSystemObject    
    fso.CopyFile my_source, my_dest, overwrite:=False

    If mycontrol = 1 Then 
        SetAttr my_source, vbNormal
        fso.DeleteFile my_source
    End If

    copyormovemyfiles = True

error_control:
    If Err.Number <> 0 Then
        ' You can select case here and handle the error
        copyormovemyfiles = False
    End If
End Function