PDA

View Full Version : [SOLVED] Run Time Error when I click on a button twice



Davespil
07-19-2016, 08:12 AM
Hello again. I have a button on my worksheet that runs a macro that generates a PDF report of the data the user just entered. If they click the button a second time while the PDF is still open they will get a run time error of -2147018887 (80071779). Is there a way to stop this from happening? I don't think its a big problem but the boss doesn't see it that way. Here is the code that I use to generate the PDF:


Sub exportPDF()
Sheets("PDF_Sheet").ExportAsFixedFormat xlTypePDF, fName, xlQualityStandard, , , , , True
End Sub

Again, thank you for all the help you've provided so far and thank you in advance for this.

JKwan
07-19-2016, 08:43 AM
Just check and see if file is open, below function is from Microsoft


Sub exportPDF()
fname = "c:\temp\junk.pdf"
If IsFileOpen(fname) Then
MsgBox "File already in use!"
Else
Sheets("PDF_Sheet").ExportAsFixedFormat xlTypePDF, fname, xlQualityStandard, , , , , True
End If
End Sub
' 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(ByVal 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
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

Davespil
07-19-2016, 02:23 PM
Just check and see if file is open, below function is from Microsoft


Sub exportPDF()
fname = "c:\temp\junk.pdf"
If IsFileOpen(fname) Then
MsgBox "File already in use!"
Else
Sheets("PDF_Sheet").ExportAsFixedFormat xlTypePDF, fname, xlQualityStandard, , , , , True
End If
End Sub
' 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(ByVal 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
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


Here is what I entered:


Sub exportPDF()
fname = "c:\temp\junk.pdf"
If IsFileOpen(fname) Then
MsgBox "File already in use!"
Else
Sheets("PDF_Sheet").ExportAsFixedFormat xlTypePDF, fname, xlQualityStandard, , , , , True
End If
End Sub
Function IsFileOpen(ByVal filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
Case 0
IsFileOpen = False
Case 70
IsFileOpen = True
Case Else
Error errnum
End Select
End Function

And when I clicked on the PDF button to start the macro I got the following:

Run-time error '53':
File not found

And when I hit debug the third to last line "Error errnum" was highlighted.

JKwan
07-19-2016, 03:51 PM
Remove the assignment of fname, I set it to a temp file so I can test it

Davespil
07-20-2016, 07:09 AM
Remove the assignment of fname, I set it to a temp file so I can test it

I removed fname = "c:\temp\junk.pdf" from the macro and now I get "Run-time error '75': Path/File access error". Here is the code right now:

Sub exportPDF()
If IsFileOpen(fname) Then
MsgBox "File already in use!"
Else
Sheets("PDF_Sheet").ExportAsFixedFormat xlTypePDF, fname, xlQualityStandard, , , , , True
End If
End Sub
Function IsFileOpen(ByVal filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
Case 0
IsFileOpen = False
Case 70
IsFileOpen = True
Case Else
Error errnum
End Select
End Function

JKwan
07-20-2016, 07:21 AM
have you assigned a value to fname? It should be full path to file.

Davespil
07-20-2016, 07:33 AM
have you assigned a value to fname? It should be full path to file.

I don't want to assign a path. I just want the data to open as a PDF and allow the used to save it where they want. Several different people on different computers will be using this tool so I don't want a default path.

JKwan
07-20-2016, 07:39 AM
well, looking at

Sheets("PDF_Sheet").ExportAsFixedFormat xlTypePDF, fName, xlQualityStandard, , , , , True

you obviously assigned fname somewhere, right, otherwise, you will get the error.

snb
07-20-2016, 07:42 AM
Sub M_snb()
with application.filedialog(4)
if .show then Sheets("PDF_Sheet").ExportAsFixedFormat 0, .selecteditems(1) & "\" & fName
end with
End Sub

Davespil
07-20-2016, 11:30 AM
well, looking at

Sheets("PDF_Sheet").ExportAsFixedFormat xlTypePDF, fName, xlQualityStandard, , , , , True

you obviously assigned fname somewhere, right, otherwise, you will get the error.

I'm not sure where. I just pulled that code of the web. I don't use fname anywhere else in the workbook.



Sub M_snb()
with application.filedialog(4)
if .show then Sheets("PDF_Sheet").ExportAsFixedFormat 0, .selecteditems(1) & "\" & fName
end with
End Sub


Is this stand alone or do I put it in with the code I already have? If so, where do I place it?

JKwan
07-20-2016, 01:08 PM
ok, found out more about the Export function. The fname (file name) is optional, so, in your case, you did not assign it a value, therefore, Excel will use your current directory (this will change). Now, knowing this, here is the revised code


Sub exportPDF()
Dim FName As String

FName = Left(ThisWorkbook.FullName, InStr(ThisWorkbook.FullName, ".")) & "pdf"
If Len(Dir(FName)) > 0 Then
If IsFileOpen(FName) Then
MsgBox "File already in use!"
Else
Sheets("PDF_Sheet").ExportAsFixedFormat xlTypePDF, FName, xlQualityStandard, , , , , True
End If
Else
Sheets("PDF_Sheet").ExportAsFixedFormat xlTypePDF, FName, xlQualityStandard, , , , , True
End If
End Sub
Function IsFileOpen(ByVal filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
Case 0
IsFileOpen = False
Case 70
IsFileOpen = True
Case Else
Error errnum
End Select
End Function

Davespil
07-20-2016, 02:46 PM
ok, found out more about the Export function. The fname (file name) is optional, so, in your case, you did not assign it a value, therefore, Excel will use your current directory (this will change). Now, knowing this, here is the revised code


Sub exportPDF()
Dim FName As String

FName = Left(ThisWorkbook.FullName, InStr(ThisWorkbook.FullName, ".")) & "pdf"
If Len(Dir(FName)) > 0 Then
If IsFileOpen(FName) Then
MsgBox "File already in use!"
Else
Sheets("PDF_Sheet").ExportAsFixedFormat xlTypePDF, FName, xlQualityStandard, , , , , True
End If
Else
Sheets("PDF_Sheet").ExportAsFixedFormat xlTypePDF, FName, xlQualityStandard, , , , , True
End If
End Sub
Function IsFileOpen(ByVal filename As String)
Dim filenum As Integer, errnum As Integer
On Error Resume Next
filenum = FreeFile()
Open filename For Input Lock Read As #filenum
Close filenum
errnum = Err
On Error GoTo 0
Select Case errnum
Case 0
IsFileOpen = False
Case 70
IsFileOpen = True
Case Else
Error errnum
End Select
End Function


Dude, that worked perfectly. Thank you!