excel - 运行 Open 语句 (I/O) 以检查 .pdf 文件是否打开时,错误 70 权限被拒绝
问题描述
为了将 Excel 工作簿导出到 .PDF 文件,当 .PDF 文件已创建并打开时,我收到错误 70 权限被拒绝。
错误出现在下面的这行代码中:
Open filename For Input Lock Read As #filenum
我尝试通过更改模式(必需。关键字指定文件模式:追加、二进制、输入、输出或随机。如果未指定,则打开文件以进行随机访问。)和锁定(可选。关键字指定其他进程对打开文件的操作限制:共享、锁定读取、锁定写入和锁定读取写入。)。但我仍然收到错误消息。
Sub exportPDF_Click()
Dim filename, filePath, PathFile As String
filename = "Name of the File"
filePath = ActiveWorkbook.Path
On Error GoTo errHandler
If Len(filename) = 0 Then Exit Sub
PathFile = filePath & "\" & filename & ".pdf"
' Check if file exists, prompt overwrite
If existFile(PathFile) Then
If MsgBox("The file already exists." & Chr (10) & "Overwrite
existing file?", _
vbQuestion + vbYesNo, "Existing File") = vbNo Then
Do
PathFile = Application.GetSaveAsFilename _
(InitialFileName:=filePath, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select a folder and a name to save the
file."
' Handle cancel
If PathFile = False Then Exit Sub
' Loop if new filename still exists
Loop While existFile(PathFile)
End If
End If
If fileOpened(PathFile) Then
GoTo errHandler
Else
ThisWorkbook.ExportAsFixedFormat _
Type:=xlTypePDF, _
filename:=PathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
Exit Sub
errHandler:
' Display a message stating the file in use.
MsgBox "The PDF file was not created." & Chr (10) & Chr (10) &
filename & ".pdf" & "has been opened by another user!"
End Sub
'=============================
Function existFile(rsFullPath As String) As Boolean
existFile = CBool(Len(Dir$(rsFullPath)) > 0)
End Function
'=============================
'=============================
Function fileOpened(PathFile As String)
' Test to see if the file is open.
fileOpened = IsFileOpen(PathFile)
End Function
'=============================
'=============================
' This function checks to see if a file is open or not. If the file is
' already open, it returns True. If the file is not open, it returns
' False. Otherwise, a run-time error occurs because there is
' some other problem accessing the file.
Function IsFileOpen(filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum '<--- error line
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case errnum
' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
Error errnum
End Select
End Function
'=============================
预期的结果是一个 MsgBox 说:
“未创建 PDF 文件。
File.pdf 的名称已被其他用户打开!”
我在这里缺少什么?
解决方案
我想我明白你在这里想要做什么。一个问题是您允许用户指定一个新文件名,但随后不检查该文件是否存在或是否可写等。我在上面的评论中指出了一些其他可能的错误,例如,如果PathFile = False
不提出就无法比较类型 13 不匹配,如果您传递不存在文件的名称,您可能会在IsFileOpen
函数中得到 53 Bad FileName or Number。
摆脱fileOpened
,除了作为 包装器之外没有任何用途IsFileOpen
,所以只需使用它IsFileOpen
。摆脱On Error
主要程序中的笨拙。如果需要,我们当然可以添加有针对性的错误处理,但我认为这不是必需的。
我已经划分/重构了下面的代码,我认为这将解决问题。特别是我写了另一个函数fileIsWriteable
并用它来包装existFile
andIsFileOpen
函数,以及消息框提示。
然后主过程针对初始的PathFile
. 如果文件不可写,则我们调用另一个新函数getNewFileName
,以确保用户选择可写(未锁定或不存在)文件名。
我认为这是不言自明的,但如果我需要澄清,请告诉我。
Option Explicit
Sub exportPDF_Click()
Dim filename$, filePath$, PathFile$
Dim fdlg As FileDialog
filename = "Book1"
filePath = "C:\debug\"
Dim mb As VbMsgBoxResult
If Len(filename) = 0 Then Exit Sub
PathFile = filePath & "\" & filename & ".pdf"
If Not fileIsWriteable(PathFile) Then
' File is NOT writeable.
PathFile = getNewFileName(filePath)
End If
If Len(PathFile) > 0 Then
ThisWorkbook.ExportAsFixedFormat _
Type:=xlTypePDF, _
filename:=PathFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
End Sub
Function fileIsWriteable(filePath As String) As Boolean
Dim mb As VbMsgBoxResult
If existFile(filePath) Then
If IsFileOpen(filePath) Then
MsgBox filePath & "has been opened by another user!"
fileIsWriteable = False
Else
mb = MsgBox(filePath & " already exists." & Chr(10) & "Overwrite existing file?", _
vbQuestion + vbYesNo, "Existing File")
fileIsWriteable = mb = vbYes
End If
Else
' file either doesn't exist, or exists but isn't open/locked, so we should
' be able to write to it:
fileIsWriteable = True
End If
End Function
Function getNewFileName(filePath As String) As String
Dim fn$
Do
fn = Application.GetSaveAsFilename( _
InitialFileName:=filePath, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select a folder and a name to save the file.")
If fn = "False" Then Exit Function
Loop While Not fileIsWriteable(fn)
getNewFileName = fn
End Function
Function existFile(rsFullPath As String) As Boolean
existFile = CBool(Len(Dir$(rsFullPath)) > 0)
End Function
Function IsFileOpen(filename As String)
' This function checks to see if a file is open or not. If the file is
' already open, it returns True. If the file is not open, it returns
' False. Otherwise, a run-time error occurs because there is
' some other problem accessing the file.
Dim filenum As Integer, errnum As Integer
On Error Resume Next ' Turn error checking off.
filenum = FreeFile() ' Get a free file number.
' Attempt to open the file and lock it.
Open filename For Input Lock Read As #filenum '<--- error line
Close filenum ' Close the file.
errnum = Err ' Save the error number that occurred.
On Error GoTo 0 ' Turn error checking back on.
' Check to see which error occurred.
Select Case errnum
' No error occurred.
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied."
' File is already opened by another user.
Case 70
IsFileOpen = True
' Another error occurred.
Case Else
Err.Raise errnum
End Select
End Function
注意:我认为这可以通过使用Application.FileDialog
而不是进一步改进,Application.GetSaveAsFileName
但我不记得如何使用该方法强制执行文件过滤器。
推荐阅读
- javascript - 用 JavaScript 中的 RegExp 在一行中解析电子邮件;使右不区分大小写但保持左
- linux - aarch64 Linux 硬浮点或软浮点
- python - 使用 XArray 数据集重现 Holoviews 示例 box_draw_roi_editor
- java - 是否有任何查询来查找 Firebase 数据库(Android Studio)中同名的孩子的数量总和?
- javascript - 有没有办法在 javascript 的 get 方法中请求多个 url?
- postgresql - 容器是数据库服务器。容器启动后,如何要求它的 Dockerfile 完成构建?
- go - 如何在 Go 中为外部 HTML 模板设置变量?
- c++ - 程序员定义的异常类问题
- kentico - Kentico - 无法以“DD/MM/YYYY”格式保存日期时间
- python - 如何仅从新列表中删除元素