vba - 如何测试 pdf 是否已打开 - 使用 Excel 宏
问题描述
我们有一个生成发票的 Excel 电子表格。我们现在需要将电子表格转换为 pdf 以通过电子邮件发送给客户。
我编写了一个宏,“按一下按钮”会生成 .pdf 并显示它(在 Acrobat 阅读器窗口中)。
但是,如果用户在 Acrobat 窗口仍然打开的情况下有意或无意地第二次按下按钮 - 宏错误。
宏是:
Sub SaveAsPDF()
'
' SaveAsPDF Macro
'
'
Application.Goto Reference:="Print_Area"
sPath = ThisWorkbook.Path
'add 'Document Properties' CustomerName & CustOrderRef to the pdf doc.
ThisWorkbook.BuiltinDocumentProperties("title").Value = Range("H13").Value & "-ref:" & Range("H14") & "-" & FormatCurrency(Range("J115").Value, 2)
'get Inv# and CustomerName
'ThisFile = ThisWorkbook.Path & "\" & "Inv" & Range("H15").Value & "-" & Range("H13").Value & ".pdf"
ThisFile = ThisWorkbook.Path & "\" & "Inv.pdf"
MsgBox "The info. will now be copied to create a PDF Invoice." & vbCrLf & "Which will be saved in the 'Invoices' folder as:" & vbCrLf & ThisFile & vbCrLf & vbCrLf & "Please press OK, and when the PDF window opens - print 2 copies on Invoice Stationery." & vbCrLf & vbCrLf & "The PDF then can be closed. (its already been saved)"
'*** Note - this code arrors if pdf is already open ! ***
'Create pdf. save it and display it on-screen - for user to print
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
filename:=ThisFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
'save & close the spreadsheet
ActiveWorkbook.Close SaveChanges:=True
ThisWorkbook.Saved = True
Application.Quit
End Sub
Function IsFileOpen(fileFullName As String)
Dim FileNumber As Integer
Dim errorNum As Integer
'MgBox "123" & fileFullName
On Error Resume Next
FileNumber = FreeFile() ' Assign a free file number.
' Attempt to open the file and lock it.
Open fileFullName For Input Lock Read As #FileNumber
Close FileNumber ' Close the file.
errorNum = Err ' Assign the Error Number which occured
On Error GoTo 0 ' Turn error checking on.
' Now Check and see which error occurred and based
' on that you can decide whether file is already
' open
Select Case errorNum
' No error occurred so ErroNum is Zero (0)
' File is NOT already open by another user.
Case 0
IsFileOpen = False
' Error number for "Permission Denied." is 70
' File is already opened by another user.
Case 70
IsFileOpen = True
' For any other Error occurred
Case Else
Error errorNum
End Select
End Function
我发现(在 StackOverflow 中)宏来测试文件是否打开(与另一个用户一起),其他人看到:IsFileOpen
上面的函数。但我不能让他们为我工作。例如IsFileOpen
错误
错误errorNum
我怎样才能最好/最简单的测试:
- 文件是否存在?
- 如果是这样,它是否已经开放阅读?
解决方案
对于“1.文件是否存在?” :
Public Function fp_FilExs(pPne$) As Boolean
fp_FilExs = CBool(LenB(Dir$(pPne, vbNormal)))
End Function
.
对于“2。如果是,它是否已经开放阅读?” :
试试下面的代码。
Tools --> Options --> General --> Error Trapping
选项
必须小于Break on all errors
。
然而,它并不是适用于所有情况的综合解决方案。
例如,使用文本文件,在 Notepad++ 中打开甚至编辑,它是行不通的......
Public Function fp_InUse(pPne$) As Boolean
Dim iFreFil%
iFreFil = FreeFile
On Error Resume Next
Open pPne For Input Lock Read Write As #iFreFil
fp_InUse = CBool(Err.Number)
Close #iFreFil
End Function
.
还可以在这里查看更复杂的解决方案,
它返回以下状态:
Select Case bResult
Case FILE_IN_USE
Label1.Caption = "File in use"
Case FILE_FREE
Label1.Caption = "File is available"
Case FILE_DOESNT_EXIST
Label1.Caption = "File does not exist!"
End Select
.