有时会拒绝终止/删除文件的权限

Question

我有一个 Excel 程序，它依赖于读取、追加和创建文本文件。

自从开始这个项目以来，每10-100次，我都会得到一个

“运行时错误‘70’：权限被拒绝”

尝试终止/删除文本文件时出错。

如果我继续执行代码，它就会起作用。

我已经对错误代码进行了一些研究，但这并没有多大帮助。

早些时候，我推测在 Excel 尝试终止该文件之前，该文件没有时间关闭。我尝试了一个等待文件关闭的函数，所以除非我的代码不起作用，否则我认为这不是问题。

这是我用于关闭和删除文件的代码。请注意，它在“Kill”命令上停止。 “isFileOpen”和“dir”命令用于检查错误是否是由于 1) 文件尚未关闭，以及 2) 文件尚未删除所致。

Close textfileorg
Close textfileNew
    'Erstatter gammelt reg med nytt reg
Do While isFileOpen(filepathorg): Loop
Kill filepathorg
Do While dir(filepathorg) <> "": Loop

Do While isFileOpen(filepath): Loop
Kill filepath
Do While dir(filepath) <> "": Loop

Name filepathNew As filepathorg

这是我的“文件是否打开”检查：

Function isFileOpen(ByRef filepath As String)

Dim textfile As Integer
textfile = FreeFile

On Error GoTo fileOpenErr

    'Forsøker å åpne fil
Open filepath For Random As textfile
Close textfile

    'Om ok, returner at fil ikke er åpen
isFileOpen = False

Exit Function

    'Ved error, returner at fil var åpen
fileOpenErr:
    isFileOpen = True

End Function

我想这个问题可以通过使用如下代码来避免：

failToKillFile:
    application.wait(time)
    resume

我觉得这只是在逃避问题。我想知道为什么会出现错误。

编辑：正如我发布此内容一样，我在尝试复制文件时遇到了类似的错误，其中副本必须替换文件。按继续，一切正常。

Answer 1

更改代码中的行

Open filepath For Random As textfile

到

Open filepath For Input Lock Read As textfile

完整代码

https://support.microsoft.com/en-us/help/291295/macro-code-to-check-whether-a-file-is-already-open<= Not longer avaliable, gone

链接消失了

Function IsFileOpen(fileName As String)

Dim fileNum As Integer
Dim errNum As Integer

'Allow all errors to happen
On Error Resume Next
fileNum = FreeFile()

'Try to open and close the file for input.
'Errors mean the file is already open
Open fileName For Input Lock Read As #fileNum
Close fileNum

'Get the error number
errNum = Err

'Do not allow errors to happen
On Error GoTo 0

'Check the Error Number
Select Case errNum

    'errNum = 0 means no errors, therefore file closed
    Case 0
    IsFileOpen = False
 
    'errNum = 70 means the file is already open
    Case 70
    IsFileOpen = True

    'Something else went wrong
    Case Else
    IsFileOpen = errNum

End Select

End Function

Answer 2

我刚刚遇到了同样的问题，权限（显然）被随机拒绝，但是......

这发生在我身上，因为我想删除的文件夹上打开了一个资源管理器窗口。

是的，仅此而已。

Answer 3

我遇到了这个问题，似乎没有什么可以解决它，直到我将kill命令移到一个单独的子例程中并从主例程中调用它......在我的例子中：

Sub KillWB()
Dim UPath As String, WB As String
UPath = "C:\Users\" & Environ("username")
WB = UPath & "\Temp.xlsx"
Kill WB
End Sub