Visual Basic - el fallo es q solo va bien en el primer fallo

Option Explicit
Dim BD As DAO.Database
Dim REGISTRO, BUSQUEDA As DAO.Recordset
Dim appAcces As New Access.Application
Dim SQL As String
Private Sub Command1_Click()
Dim e As Boolean
Dim m, m1, t, p, origen, destino As String
Dim f1, f2 As String
Dim AppPath As String
origen = App.Path & "\COD.mde"
destino = App.Path & "\COD1.mde"
Name origen As destino
e = appAcces.CompactRepair(LogFile:=True, _
SourceFile:=destino, _
DestinationFile:=origen)
Kill destino
Set BD = OpenDatabase(origen)
m = "Introduce la fecha inicial(dd/mm/aaaa):"
m1 = "Introduce la fecha final(dd/mm/aaaa):"
t = "Seleccione el intervalo de fechas(dd/mm/aaaa):"
p = ""
SQL = "DELETE * FROM PRUEBA"
BD.Execute (SQL)
SQL = "INSERT INTO PRUEBA SELECT TABLA.FESTIVO,TABLA.DIA,TABLA.EDAD,TABLA.HORA,TABLA.PROVINCIA,TABLA.SEXO,TABLA.ENTRADA FROM TABLA;"
BD.Execute (SQL)
fecha:
On Error GoTo error
f1 = InputBox(m, t, p, 100, 100)
f2 = InputBox(m1, t, p, 100, 100)
SQL = "DELETE FROM PRUEBA WHERE PRUEBA.DIA< #" & f1 & "#"
BD.Execute (SQL)
SQL = "DELETE FROM PRUEBA WHERE PRUEBA.DIA> #" & f2 & "#"
BD.Execute (SQL)
BD.Close
appAcces.OpenCurrentDatabase origen
appAcces.RunCommand acCmdAppMaximize

error:
If Err = 3075 Then
MsgBox ("Introduce una fecha correcta")
GoTo fecha
End If
End Sub
Private Sub Picture1_Click()
End
End Sub