Visual Basic para Aplicaciones - Error en código

Private Sub cmdActualizarPHS_Click()

'Arreglar de la tabla todos modelos los que no tenian la información

On Error GoTo Err_ArreglarDatos

    Dim sql As String

    Dim model As String

    Dim stDocName As String

    Dim TBL As Recordset

    Dim TBL1 As Recordset

    Dim TBL2 As Recordset

    Dim sFuente As String, sSet As String, sDeno As String

    Dim sFaseProyecto As String, sSituacion As String, sFechaRevision As String, sZonaProcesos As String

    Dim sDesmontaje As String, sFuenteTBL1 As String

    Dim ObjExcel As Object

    Dim lFilaPHs As Long, lFilaPHSNuevo As Long, lFilaPHSContado As Long

    Dim kk As Integer

    'Debug.Print "PASO 1"

    'stDocName = "modelo"

    'Lanzar la macro con nombre modelo: (Introduce el modelo en la tabla modelo: 'INSERT INTO modelo (modelo) VALUES(Formularios![nuevo_modelo]![Modelo] ), Sí)

    'DoCmd.RunMacro stDocName

    'Establecer db como la base de datos actual

    Set db = CurrentDb

    'Establecer TBL como la tabla de PHS_Desm

    sql = "SELECT * FROM PHS_Desm"

    Set TBL = db.OpenRecordset(sql)

    'Establecer TBL1 como la tabla todos los modelos

    sql = "SELECT * FROM Todosmodelos"

    Set TBL1 = db.OpenRecordset(sql)

    'Debug.Print "PASO 2"

    If Opcion0.Value = True Then

        'DefinirRuta

        'sRutaDefinitiva = "\\vfesseatmarp\PP\PP_2\PP_2FD\Compartida\03_Presentaciones\6.-Control proyecto\PHS\actualizaciones_PHS\wissenswerk" & txtRutaFichero.Value & ".xls"

        sRutaDefinitiva = "C:\Temp\" & txtRutaFichero.Value & ".xls"

        'Abrir excel

        Set ObjExcel = CreateObject("Excel.Application")

        ObjExcel.Workbooks.Open FileName:=sRutaDefinitiva

        lFilas = 1

        Do Until ObjExcel.Range("A" & lFilas).Value = ""

            lFilas = lFilas + 1

            If ObjExcel.Range("A" & lFilas).Value = "" Then

                Exit Sub

            End If

            sPHS = "PHS_" & ObjExcel.Range("A" & lFilas)

            If sPHS = "PHS_111" Then

                aa = aa

            End If

            sSituacion = ObjExcel.Range("B" & lFilas)

            sFechaRevision = ObjExcel.Range("C" & lFilas)

            sDenominacion = ObjExcel.Range("D" & lFilas)

            sDenominacion = Replace(sDenominacion, "'", "")

            sFaseProyecto = ObjExcel.Range("E" & lFilas)

            sZonaProcesos = ObjExcel.Range("F" & lFilas)

            sSet = ObjExcel.Range("G" & lFilas)

            TBL.MoveFirst

            sExiste = False

            lFilaPHSNuevo = 0

            Do Until TBL.EOF

                If sPHS = TBL1(Fuente) Then

                    'sql = "Update Todosmodelos SET (Situacion ='" & sSituacion & "', Fecha ='" & sFechaRevision & "', FP ='" & sFaseProyecto & "', ZP ='" & sZonaProcesos & '") WHERE Id_PHS_Desm =" & lFilaPHs & ";"

                    'db.Execute (sql)

                    DoCmd.RunSQL "Update Todosmodelos SET Situacion = " & sSituacion & ", Fecha ='" & sFechaRevision & "', FP ='" & sFaseProyecto & "', ZP ='" & sZonaProcesos & "'  WHERE Id_PHS_Desm =" & lFilaPHs & ";"

                End If

                TBL.MoveNext

                lFilaPHSNuevo = lFilaPHSNuevo + 1

            Loop