Code Execution has been interrupted

I get the subject error message when I try to execute this code.

At the moment, it stops on the DoEvents line. It really doesn't matter what I have on this line. It always fails at that point after opening the file successfully. However, I can start before opening the file and step though the code manually and it executes properly. There is no error number or description other than "I quit!"

Option Explicit
Global shD As Worksheet             ' Destination workhset

Dim xlS As Workbook                 ' Source Workbook
Dim shS As Worksheet                ' Source Sheet
Dim PathName As String              ' Pathname to file
Dim FileName As String              ' File name

Sub OnOpen()
Dim xlD As Workbook
' initalize variables
PathName = ThisWorkbook.Path
FileName = "athletes.xlsm"
Set xlD = ThisWorkbook
Set shD = Sheets("Blad1")

' Check for athelete file
If Dir(PathName & "\" & FileName) = "" Then
    MsgBox "The file, " & FileName & " does not exist in the current directory.", vbOKOnly + vbCritical, _
        "File Name Does Not Exist"
    Exit Sub
End If


' Open the file
Set xlS = Workbooks.Open(PathName & "\" & FileName)
' Check that sheet exists
'On Error GoTo MyExit
DoEvents
Set shS = xlS.Sheets("Athletes")

xlD.Activate

Exit Sub

MyExit:
MsgBox "Sheet, Athletes, does not exist in the workbook", vbOKOnly + vbCritical, "Sheet Does Not Exist"
xlS.Close savechanges:=False

End Sub

I was wondering what I did wrong with my coding until another program that I have been using daily for months started doing the same thing. It opened a file and fainted at the very next line. Closing and re-opening Excel did nothing, so I had to reboot. Both programs now execute properly at least as far as proceeding beyond file open. Now I have to back out all the debugging code I put in .

It appears that a bad image of the excel executable was lurking somewhere in memory and could only be erased by "pulling the plug."