Error Capture Problem

[leerem]

have the following code as below:

Sub Anything()
' More code

' Open up Dialog box to select file to open
Fileselect:
On Error GoTo ErrorHandler
Application.Dialogs(xlDialogOpen).Show

'Turn Screen Updating off
Application.ScreenUpdating = False

' Get the File Address of the Newly Opened WorkBook and assign its address
to FileAddress
Application.DisplayAlerts = False
FileAddress = ActiveWorkbook.FullName

' More code

ErrorHandler:
If Err.Number = 1004 Then
MsgBox "You tried to open a file which has an incorrect file
extension" & NL & _
"Please try again!", vbOKOnly, "Wrong File Extension"
Err.clear
GoTo Fileselect
End If
End Sub

When run and I Delibratly choose an incorrect file name, (for error trapping
purposes) the On Error routine works fine, however when as detailed it
returns to 'Fileselect' and reopens the dialogbox with
Application.Dialogs(xlDialogOpen).Show. I then once again select the wrong
file name and the Error Routine doesn't capture the error. instead it gives
me a standard message box with run time error 1004 with options to END ,Debug
and Help. How can I capture it a second and possible third time if the user
selects the same file repeatedly.

Your help would be most appreciated
regards

lee

 

[Jacob Skaria]

Try the below macro and feedback

--Filters can be applied
--Check for file extension
--User will have the option to cancel the process

Sub Macro()

Dim strFile As String, blnCheck As Boolean

Do While blnCheck = False
On Error Resume Next
With Application.FileDialog(msoFileDialogOpen)
.Filters.Delete
.Filters.Add "MS Excel Files", "*.xls", 1
.InitialFileName = "C:\"
.Show
If .SelectedItems.Count > 0 Then blnCheck = True
strFile = .SelectedItems(1)
End With
If blnCheck <> True Then
If MsgBox("You have not selected a file. Cancel Operation?", _
vbYesNo) = vbYes Then Exit Sub
Else
If UCase(Mid(strFile, InStrRev(strFile, "."))) <> ".XLS" Then
MsgBox "Wrong file extension. Select a valid file"
blnCheck = False
End If
End If
Loop

MsgBox strFile

End Sub

If this post helps click Yes

 

[leerem]

many thanks for the new code, I'll use yours as it's Filters more criteria: I
also managed to rectify my own problem by replacing the Goto statement with
Resume

Once again many thanks for taking the time to assist me
regards

Lee