Tratamiento de errores erróneo?

   Buenos días.Tengo el siguiente código, al que le he puesto un tratamiento de errores con una etiqueta al final con opciones para los distintos errores que creo que se pueden producir, pero no se por qué motivo no hace dicho tratamiento de errores y cuando se produce un error me abre la ventana de depuración, como si no existiera la etiqueta.
El código es un sub de un módulo que se activa desde un evento de un botón de un formulario y hace llamadas a otro procedimento sub (guardar_como).  Este es el código:

Sub ceexcred()

On Error GoTo etiqueta

terminado = False

' Rutas de origen y destino
Dim ruta_origen As String, plantilla As String, plantilla_origen As String
ruta_origen = CurrentProject.Path & "\_PLANTILLAS\"
plantilla = "Certificado de Existencia crédito.docx"
plantilla_origen = ruta_origen & plantilla

Dim ruta_destino As String, plantilla_destino As String
ruta_destino = frm!diet_ruta.Value & "\"
plantilla_destino = ruta_destino & plantilla

' Copia la plantilla a la ruta de destino
On Error Resume Next
FileCopy plantilla_origen, plantilla_destino
If err.Number <> 0 Then
    MsgBox "Error al copiar la plantilla. Asegúrate de que la ruta de destino exista.", vbExclamation
    err.Clear
    Exit Sub
End If
On Error GoTo 0

'' Nombre y ruta del archivo original
strFileName = plantilla

' Lanzamiento de Word
Set AppWord = New Word.Application
AppWord.Visible = True

' Apertura de la carta modelo
'    On Error Resume Next ' Ignorar errores
'    Set DocWord = AppWord.Documents.Open(strFilePath & "\" & strFileName)
    Set DocWord = AppWord.Documents.Open(plantilla_destino)

'    If err.Number <> 0 Then ' Ocurrió un error al abrir el documento
'        MsgBox "Error al abrir el documento de Word. Asegúrate de que el archivo no esté abierto.", vbExclamation
'        err.Clear
'        Set DocWord = Nothing
''        Set objWord = Nothing
'        Exit Sub
'    End If
'
'    On Error GoTo 0 ' Reanudar el manejo de errores normal

'   Datos a marcadores
With DocWord.Bookmarks

        .Item("Consejeria1").Range.Text = textfirma_Consejeria1
        .Item("Consejeria2").Range.Text = textfirma_Consejeria2
        .Item("presup_firmante").Range.Text = textfirma_presup_firmante
        .Item("presup_cargo").Range.Text = textfirma_presup_cargo
        .Item("Consejeria11").Range.Text = textfirma_Consejeria1
        .Item("Consejeria21").Range.Text = textfirma_Consejeria2
        .Item("CA").Range.Text = textfirma_CA
        .Item("Organismo").Range.Text = frm!diet_organismo
        .Item("Programa").Range.Text = frm!diet_programa
        .Item("Subconcepto").Range.Text = frm!diet_subconcepto
        .Item("Tipo_gasto").Range.Text = tipo_gasto
        .Item("Proyecto").Range.Text = frm!diet_proyecto
        .Item("Importe_total").Range.Text = Format(frm!diet_importe_total, "#,##0.00 €")

End With

terminado = True

MsgBox "Guarde el documento en su ruta de T:\, para evitar sobreescribir la plantilla"

'Direcciona ruta del documento
Dim rutaPorDefecto As String
rutaPorDefecto = frm!diet_ruta.Value

guardar_como AppWord, rutaPorDefecto

'Una vez guardado el word con los datos, borra la plantilla en ruta destino
Kill plantilla_destino

Exit Sub
etiqueta:

If err.Number = 76 Then
    MsgBox "Ha introducido una ruta no válida para guardar los archivos de este expediente"
    Firmantes
    normativa
End If

If err.Number = 94 Then
    MsgBox "Ha dejado en blanco algún dato imprescindible para el documento. Revíselo."
    Firmantes
    normativa
End If

If err.Number = 70 Then
    MsgBox "Tiene abierto en word el documento destino. Ciérrelo y vuelva a intentarlo."
    Firmantes
    normativa
End If

End Sub

No se qué es lo que he hecho mal para que al producirse un error no pase por la etiqueta. Os agradecería una ayudita. Muchas gracias.

Autor	Mensaje Tema Buscar Opciones del Tema Responder Crear un nuevo tema Versión imprimible Traducir Tema
Kublai Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Habitual Unido: 11/Julio/2020 Localización: Murcia Estado: Sin conexión Puntos: 162	Tema: Tratamiento de errores erróneo? Enviado: 25/Julio/2023 a las 10:13
	Buenos días. Tengo el siguiente código, al que le he puesto un tratamiento de errores con una etiqueta al final con opciones para los distintos errores que creo que se pueden producir, pero no se por qué motivo no hace dicho tratamiento de errores y cuando se produce un error me abre la ventana de depuración, como si no existiera la etiqueta. El código es un sub de un módulo que se activa desde un evento de un botón de un formulario y hace llamadas a otro procedimento sub (guardar_como). Este es el código: Sub ceexcred() On Error GoTo etiqueta terminado = False ' Rutas de origen y destino Dim ruta_origen As String, plantilla As String, plantilla_origen As String ruta_origen = CurrentProject.Path & "\_PLANTILLAS\" plantilla = "Certificado de Existencia crédito.docx" plantilla_origen = ruta_origen & plantilla Dim ruta_destino As String, plantilla_destino As String ruta_destino = frm!diet_ruta.Value & "\" plantilla_destino = ruta_destino & plantilla ' Copia la plantilla a la ruta de destino On Error Resume Next FileCopy plantilla_origen, plantilla_destino If err.Number <> 0 Then MsgBox "Error al copiar la plantilla. Asegúrate de que la ruta de destino exista.", vbExclamation err.Clear Exit Sub End If On Error GoTo 0 '' Nombre y ruta del archivo original strFileName = plantilla ' Lanzamiento de Word Set AppWord = New Word.Application AppWord.Visible = True ' Apertura de la carta modelo ' On Error Resume Next ' Ignorar errores ' Set DocWord = AppWord.Documents.Open(strFilePath & "\" & strFileName) Set DocWord = AppWord.Documents.Open(plantilla_destino) ' If err.Number <> 0 Then ' Ocurrió un error al abrir el documento ' MsgBox "Error al abrir el documento de Word. Asegúrate de que el archivo no esté abierto.", vbExclamation ' err.Clear ' Set DocWord = Nothing '' Set objWord = Nothing ' Exit Sub ' End If ' ' On Error GoTo 0 ' Reanudar el manejo de errores normal ' Datos a marcadores With DocWord.Bookmarks .Item("Consejeria1").Range.Text = textfirma_Consejeria1 .Item("Consejeria2").Range.Text = textfirma_Consejeria2 .Item("presup_firmante").Range.Text = textfirma_presup_firmante .Item("presup_cargo").Range.Text = textfirma_presup_cargo .Item("Consejeria11").Range.Text = textfirma_Consejeria1 .Item("Consejeria21").Range.Text = textfirma_Consejeria2 .Item("CA").Range.Text = textfirma_CA .Item("Organismo").Range.Text = frm!diet_organismo .Item("Programa").Range.Text = frm!diet_programa .Item("Subconcepto").Range.Text = frm!diet_subconcepto .Item("Tipo_gasto").Range.Text = tipo_gasto .Item("Proyecto").Range.Text = frm!diet_proyecto .Item("Importe_total").Range.Text = Format(frm!diet_importe_total, "#,##0.00 €") End With terminado = True MsgBox "Guarde el documento en su ruta de T:\, para evitar sobreescribir la plantilla" 'Direcciona ruta del documento Dim rutaPorDefecto As String rutaPorDefecto = frm!diet_ruta.Value guardar_como AppWord, rutaPorDefecto 'Una vez guardado el word con los datos, borra la plantilla en ruta destino Kill plantilla_destino Exit Sub etiqueta: If err.Number = 76 Then MsgBox "Ha introducido una ruta no válida para guardar los archivos de este expediente" Firmantes normativa End If If err.Number = 94 Then MsgBox "Ha dejado en blanco algún dato imprescindible para el documento. Revíselo." Firmantes normativa End If If err.Number = 70 Then MsgBox "Tiene abierto en word el documento destino. Ciérrelo y vuelva a intentarlo." Firmantes normativa End If End Sub No se qué es lo que he hecho mal para que al producirse un error no pase por la etiqueta. Os agradecería una ayudita. Muchas gracias.

Mihura Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Visite la página de los usuarios Añadir a la lista de amigos Administrador Unido: 06/Mayo/2005 Localización: En la dehesa Estado: Sin conexión Puntos: 14428	Enviado: 25/Julio/2023 a las 10:15
	Hace lo que debe, yo veo ahí un: Error Resume Next
	Jesús Mansilla Castells. Saludos desde Móstoles. Access Aplicaciones Tecsys.es

Kublai Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Habitual Unido: 11/Julio/2020 Localización: Murcia Estado: Sin conexión Puntos: 162	Enviado: 25/Julio/2023 a las 10:22
	He comentado la línea del On error resume next y la del On error goto 0 y sigue haciendo lo mismo. No pasa por la etiqueta

Mihura Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Visite la página de los usuarios Añadir a la lista de amigos Administrador Unido: 06/Mayo/2005 Localización: En la dehesa Estado: Sin conexión Puntos: 14428	Enviado: 25/Julio/2023 a las 10:26
	¿Puedes 'pegar' el código tal cuál está ahora?
	Jesús Mansilla Castells. Saludos desde Móstoles. Access Aplicaciones Tecsys.es

Kublai Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Habitual Unido: 11/Julio/2020 Localización: Murcia Estado: Sin conexión Puntos: 162	Enviado: 25/Julio/2023 a las 10:28
	Sub ceexcred() On Error GoTo etiqueta terminado = False ' Rutas de origen y destino Dim ruta_origen As String, plantilla As String, plantilla_origen As String ruta_origen = CurrentProject.Path & "\_PLANTILLAS\" plantilla = "Certificado de Existencia crédito.docx" plantilla_origen = ruta_origen & plantilla Dim ruta_destino As String, plantilla_destino As String ruta_destino = frm!diet_ruta.Value & "\" plantilla_destino = ruta_destino & plantilla ' Copia la plantilla a la ruta de destino 'On Error Resume Next FileCopy plantilla_origen, plantilla_destino If err.Number <> 0 Then MsgBox "Error al copiar la plantilla. Asegúrate de que la ruta de destino exista.", vbExclamation err.Clear Exit Sub End If 'On Error GoTo 0 '' Nombre y ruta del archivo original strFileName = plantilla ' Lanzamiento de Word Set AppWord = New Word.Application AppWord.Visible = True ' Apertura de la carta modelo ' On Error Resume Next ' Ignorar errores ' Set DocWord = AppWord.Documents.Open(strFilePath & "\" & strFileName) Set DocWord = AppWord.Documents.Open(plantilla_destino) ' If err.Number <> 0 Then ' Ocurrió un error al abrir el documento ' MsgBox "Error al abrir el documento de Word. Asegúrate de que el archivo no esté abierto.", vbExclamation ' err.Clear ' Set DocWord = Nothing '' Set objWord = Nothing ' Exit Sub ' End If ' ' On Error GoTo 0 ' Reanudar el manejo de errores normal ' Datos a marcadores With DocWord.Bookmarks .Item("Consejeria1").Range.Text = textfirma_Consejeria1 .Item("Consejeria2").Range.Text = textfirma_Consejeria2 .Item("presup_firmante").Range.Text = textfirma_presup_firmante .Item("presup_cargo").Range.Text = textfirma_presup_cargo .Item("Consejeria11").Range.Text = textfirma_Consejeria1 .Item("Consejeria21").Range.Text = textfirma_Consejeria2 .Item("CA").Range.Text = textfirma_CA .Item("Organismo").Range.Text = frm!diet_organismo .Item("Programa").Range.Text = frm!diet_programa .Item("Subconcepto").Range.Text = frm!diet_subconcepto .Item("Tipo_gasto").Range.Text = tipo_gasto .Item("Proyecto").Range.Text = frm!diet_proyecto .Item("Importe_total").Range.Text = Format(frm!diet_importe_total, "#,##0.00 €") End With terminado = True MsgBox "Guarde el documento en su ruta de T:\, para evitar sobreescribir la plantilla" 'Direcciona ruta del documento Dim rutaPorDefecto As String rutaPorDefecto = frm!diet_ruta.Value guardar_como AppWord, rutaPorDefecto 'Una vez guardado el word con los datos, borra la plantilla en ruta destino Kill plantilla_destino Exit Sub etiqueta: If err.Number = 76 Then MsgBox "Ha introducido una ruta no válida para guardar los archivos de este expediente" Firmantes normativa End If If err.Number = 94 Then MsgBox "Ha dejado en blanco algún dato imprescindible para el documento. Revíselo." Firmantes normativa End If If err.Number = 70 Then MsgBox "Tiene abierto en word el documento destino. Ciérrelo y vuelva a intentarlo." Firmantes normativa End If End Sub

Mihura Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Visite la página de los usuarios Añadir a la lista de amigos Administrador Unido: 06/Mayo/2005 Localización: En la dehesa Estado: Sin conexión Puntos: 14428	Enviado: 25/Julio/2023 a las 10:53
	¿No tendrás un error resume next en dónde lances la sub ceexcred?
	Jesús Mansilla Castells. Saludos desde Móstoles. Access Aplicaciones Tecsys.es

Kublai Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Habitual Unido: 11/Julio/2020 Localización: Murcia Estado: Sin conexión Puntos: 162	Enviado: 25/Julio/2023 a las 11:06
	En el evento click del botón que lanza la sub ceexcred no había ningún On error resume next. Sí había uno en el evento load del formulario, pero ya lo he comentado también y aún así no he conseguido nada... De todas formas, la instrucción de inicio del sub (on error goto etiqueta) no anularía cualquier resume next?

Mihura Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Visite la página de los usuarios Añadir a la lista de amigos Administrador Unido: 06/Mayo/2005 Localización: En la dehesa Estado: Sin conexión Puntos: 14428	Enviado: 25/Julio/2023 a las 11:27
	Anterior si. En otro formulario -en blanco-, create una sub que tenga un error, por ejemplo meter 1.000.000 en un integer ¿ te funciona el control de errores ?
	Jesús Mansilla Castells. Saludos desde Móstoles. Access Aplicaciones Tecsys.es

Kublai Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Habitual Unido: 11/Julio/2020 Localización: Murcia Estado: Sin conexión Puntos: 162	Enviado: 25/Julio/2023 a las 11:48
	He hecho lo que me dices: formulario en blanco y botón con el código que sigue. Y tampoco pasa por la etiqueta. El código es: Private Sub Comando0_Click() On Error GoTo etiqueta Dim num As Integer num = 1E+30 Exit Sub etiqueta: If err.Number = 6 Then MsgBox "ha pasado por la etiqueta" End If End Sub

Mihura Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Visite la página de los usuarios Añadir a la lista de amigos Administrador Unido: 06/Mayo/2005 Localización: En la dehesa Estado: Sin conexión Puntos: 14428	Enviado: 25/Julio/2023 a las 12:59
	Probablemente tengas algo 'superior' que esté interceptando el control de errores. Si no encuentras nada, prueba a crearte una B.D. en blanco e importa solo lo que necesites para poder probarlo en ella, a ver que ocurre.
	Jesús Mansilla Castells. Saludos desde Móstoles. Access Aplicaciones Tecsys.es

Kublai Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Habitual Unido: 11/Julio/2020 Localización: Murcia Estado: Sin conexión Puntos: 162	Enviado: 25/Julio/2023 a las 13:06
	He creado una BD en blanco, he importado el formulario este último con el error de desbordamiento y estamos en las mismas: no pasa por la etiqueta. La versión de officce que tengo es la 2021. Puede tener algo que ver?

Mihura Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Visite la página de los usuarios Añadir a la lista de amigos Administrador Unido: 06/Mayo/2005 Localización: En la dehesa Estado: Sin conexión Puntos: 14428	Enviado: 25/Julio/2023 a las 14:19
	No sé que decirte ...
	Jesús Mansilla Castells. Saludos desde Móstoles. Access Aplicaciones Tecsys.es

pitxiku Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Colaborador Unido: 27/Septiembre/2017 Localización: En mi casa Estado: Sin conexión Puntos: 1536	Enviado: 26/Julio/2023 a las 09:08
	¿Has usado la ejecución paso a paso o puesto puntos de interrupción? Porque el último control de errores sólo hará algo cuando se produzca el error 6. También puedes usar un Else para los errores no identificados: [Code] Private Sub Comando0_Click() On Error GoTo etiqueta Dim num As Integer num = 1E+30 Exit Sub etiqueta: If err.Number = 6 Then MsgBox "ha pasado por la etiqueta y es el error de desbordamiento" Else MsgBox "ha pasado por la etiqueta y es el error no identificado " & Err End If 'También se puede limpiar el error Err.Clear End Sub Editado por pitxiku - 26/Julio/2023 a las 09:08

Kublai Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Habitual Unido: 11/Julio/2020 Localización: Murcia Estado: Sin conexión Puntos: 162	Enviado: 26/Julio/2023 a las 09:44
	Es que creo que el problema lo tengo con el propio programa access porque, si bien el código donde he detectado el error era complejo y podía haber dificultad para detectar el fallo, he hecho lo que me comentó Mihura (crear un formulario sencillo con un botón, un error inducido como el desbordamiento) y sigue dando el mismo fallo (no hace caso a la instrucción On error goto etiqueta y nunca pasa por la etiqueta)

pitxiku Ver perfil usuario Enviar mensaje privado Ver los mensajes del usuario Añadir a la lista de amigos Colaborador Unido: 27/Septiembre/2017 Localización: En mi casa Estado: Sin conexión Puntos: 1536	Enviado: 26/Julio/2023 a las 11:59
	El tratamiento de errores que hay en tu último código hace lo siguiente: Si se produce el error 6 lanza un mensaje No hace nada más: ni borra el error, ni controla otros errores, ni lanza otros mensajes, nada. Por eso pienso que te lanza el mensaje estándar de VBA, porque aunque llegue a la etiqueta no le dices que haga algo con el error. Llegas al final de esa subrutina y como sigues teniendo el error, salta el mensaje estándar. Y por eso mi pregunta: ¿Has comprobado con puntos de interrupción y ejecución paso a paso que realmente no pasa por la etiqueta?

Responder	Página 12 >
Tweet