Código de macro que no se ejecuta desde botón en excel no se porque ..

El problema es muy simple, estoy haciendo un rastreo de los IP que están asignados y sacándole el nombre de maquina a cada uno de ellos esto lo logre poder ejecutar , pero de un segundo para otro se cerro el excel y no se porque después la macro no funcionaba, he revisado una y otra ves la macro la manera de llamar la función y el parámetro que le entrego y esta todo bien por eso no me cuadra que no se ejecute.

el código de la macro el es siguiente

Private Sub WorkBook_Open()
Application.OnTime Now() + TimeValue("00:00:05"), "MyProc"
End Sub
Sub MyProc()
Application.Calculation = xlCalculationAutomatic
End Sub
Public Function f_EquipoResponde(str_Equipo As String) As String
Dim obj_Shell As Object
Dim obj_FileSystem As Object
Dim obj_Fichero As Object
Dim str_ContenidoFichero As String
Dim str_FicheroTemporal As String
Dim str_NombreMaquina As String

Set obj_Shell = CreateObject("WScript.Shell")
Set obj_FileSystem = CreateObject("Scripting.FileSystemObject")

str_FicheroTemporal = ThisWorkbook.Path & "\temp.txt"
obj_Shell.Run "cmd /c ping -a -n 2 " & str_Equipo & " > """ & _
str_FicheroTemporal & """", 0, True

Set obj_Fichero = obj_FileSystem.OpenTextFile(str_FicheroTemporal, 1, False)

str_ContenidoFichero = obj_Fichero.ReadAll

obj_Fichero.Close
Set obj_Fichero = Nothing

obj_FileSystem.DeleteFile (str_FicheroTemporal)
Set obj_FileSystem = Nothing
Set obj_Shell = Nothing

Dim nombre As String
nombre = Mid(Replace(str_ContenidoFichero, vbCrLf, ""), 17, 10)

If InStr(str_ContenidoFichero, "perdidos = 0") > 0 Then
f_EquipoResponde = nombre & " ha RECIBIDOS 100% "
End If
If InStr(str_ContenidoFichero, "perdidos = 1") > 0 Then
f_EquipoResponde = nombre & "ha RECIBIDOS 50%"
End If
If InStr(str_ContenidoFichero, "perdidos = 2") > 0 Then
f_EquipoResponde = "IP VACANTE"
End If
End Function

Cualquier ayuda es bienvenida , de antemano muchas gracias