MSAccess падает при попытке открыть файл - PullRequest
Новая
       31

MSAccess падает при попытке открыть файл

0 голосов
/ 05 ноября 2019

Я новичок, так что будьте добры ко мне.

Я использую Office 365 на ПК с Windows 10.

У меня есть некоторый код VBA в Access, чтобы проверить, открыт ли файлили заблокирован (файл является локальным для этого ПК). Когда я запускаю этот код на одном компьютере, он работает для большинства файлов, но постоянно вылетает, когда достигает определенного набора файлов. Каждый раз это один и тот же набор файлов (если я вручную перехожу через код, чтобы перейти от первого файла. Я попытался перезагрузить компьютер, чтобы снять все блокировки, но результат тот же.

КогдаЯ говорю сбой, я имею в виду, что я теряю контроль над Access и Windows сообщает, что он больше не отвечает.

Если я запускаю один и тот же код на другом ПК, хотя ссылаюсь на те же файлы на исходном ПК,он сообщает, что файл заблокирован, но не вылетает. Интересно, за исключением того, что файл не заблокирован, или не так, как я понимаю блокировку файла. Из пользовательского интерфейса я могу переименовывать, перемещать или удалять файлы по своему усмотрению.

Я вполне уверен, что в написанном коде VBA нет ничего плохого, и начинаю думать, что где-то может быть поврежденная DLL.

Я приложил изображение текущих ссылок на VBA на случай, еслиздесь есть какая-либо ошибка. Изображение ссылок VBA

Мой код следует. Он вылетает на линии Открыть my_source для ввода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

1 Ответ

1 голос
/ 06 ноября 2019

Лучше всего просто выполнить действие, а затем разобраться со случаем сбоя, а не тестировать заранее. Причина в том, что состояние может измениться между вашим тестом и действием. Кроме того, вы создаете ошибки вручную, когда вы можете просто позволить своему коду поднять ошибки органически.

Таким образом, вы говорите, что ваша копия не будет перезаписана, но затем вы говорите команде копирования перезаписать. Если мы скажем не перезаписывать, нам больше не придется проверять, существует ли источник или место назначения, оба они приводят к явным ошибкам.

ПРИМЕЧАНИЕ. Не используйте подчеркивание "_" в именах переменных или функций, поскольку они используются для определений событий в обработчике событий 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
...