Как проверить, открыт ли pdf - с помощью макроса Excel

Question

У нас есть электронная таблица Excel, которая создает счета.Теперь нам нужно преобразовать электронную таблицу в pdf для отправки по электронной почте клиенту.

Я написал макрос, который «одним нажатием кнопки» создает файл .pdf и отображает его (в окне программы чтения Acrobat).

Однако, если пользователь намеренно или непреднамеренно нажимает кнопку 2-й раз, когда окно 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. Файл существует?
2. Если так, он уже открыт для чтения?

Answer 1

Для "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

.

Answer 2

Хотя я понимаю, что это по сути та же функция.Кажется, это немного по-другому ... может, примените это и посмотрите, поможет ли это?

Public Function IsFileOpen(FileName As String, Optional ResultOnBadFile As Variant) As Variant

Dim FileNum As Integer
Dim ErrNum As Integer
Dim V As Variant

On Error Resume Next

If Trim(FileName) = vbNullString Then
    If IsMissing(ResultOnBadFile) = True Then
        IsFileOpen = False
    Else
        IsFileOpen = ResultOnBadFile
    End If
    Exit Function
End If

V = Dir(FileName, vbNormal)
If IsError(V) = True Then
    If IsMissing(ResultOnBadFile) = True Then
        IsFileOpen = False
    Else
        IsFileOpen = ResultOnBadFile
    End If
    Exit Function
ElseIf V = vbNullString Then
    If IsMissing(ResultOnBadFile) = True Then
        IsFileOpen = False
    Else
        IsFileOpen = ResultOnBadFile
    End If
    Exit Function
End If

FileNum = FreeFile()
Err.Clear
Open FileName For Input Lock Read As #FileNum
ErrNum = Err.Number

Close FileNum
On Error GoTo 0

Select Case ErrNum
    Case 0
        IsFileOpen = False
    Case 70
        IsFileOpen = True
    Case Else
        IsFileOpen = True
End Select

End Function

Я назову это так:

If IsFileOpen(ActiveWorkbook.Path & "\" & Month(Date) & "-" & Year(Date) & ".pdf") = False Then 'rest of code. Obviously you have to change path and name to your needs.