Access - Almacenar errores VBA en una tabla

Buenos días,

Tengo un recordset, que envía correos uno a uno, de una tabla que tiene varios cientos de registros.
El problema es que al detectar un error, en este caso en el formato del correo electrónico, me para y me quedo en ese registro malo, que tengo que localizar, modificar y borrar la bola anterior.

Quisiera que al error pudiese guardar ese campo en una tabla y que prosiguiera el recordset, como lo hago?

Gracias!

Hola!

Te explico una manera de hacerlo. Como no sé ni la estructura de tu tabla ni la estructura de tu código te lo voy a poner un poco en abstracto y sobre unos supuestos.

El primer supuesto es que existe un campo identificador de registro, para saber a qué registro corresponde el error. A ese campo lo llamaré Id

Te pondré un ejemplo sobre el error 94, que es el uso no válido de null. Eso implica que, en el ejemplo, el campo [Valor] de la tabla auxiliar (lo explico más adelante) no contendría valor para este ejemplo, pero te serviría para situar el valor del campo incorrecto para otro tipo de error.

Lo que tienes que hacer es lo siguiente:

- Te creas una tabla auxiliar, que yo llamaré TAux, con cuatro campos:
[Id] - Numérico
[Valor]->Texto
[NError]->Numérico
[DError]->Texto

Al inicio de tu código escribes un control de errores y una ejecución de SQL
...
On error goto sol_err
docmd.setwarnings false
docmd.runSql("DELETE FROM TAux")
docmd.setwarnings true
....
Eso te borra toda la información que pudiera haber en TAux.

A continuación te creas un recordset sobre TAux, así:
...
Dim rstAux as DAO.Recordset
Set rstAux=currentdb.openrecordset("TAux",dbOpenTable)
...

A partir de aquí vendría tu código.

En tu código, justo antes de la línea de código que mueve tu recordset al registro siguiente, le plantas la etiqueta Siguiente: Por ejemplo, si tu recorset se llama rst escribirías (importante ponerle los dos puntos al final de la etiqueta)

Siguiente:
rst.Movenext

Cuando acaba tu código le escribes un EXIT SUB

Debajo del EXIT SUB escribes (de nuevo, ojo con los dos puntos al final de la etiqueta):

Exit Sub
sol_err:
SELECT CASE err.number
CASE 94
rstAux.addnew
rstAux.fields(0).value=rst.Fields("IdentificadorDeTuTabla").value
rstAux.fields(1).value=rst.Fields("CampoConflictivo").value
rstAux.fields(2).value=err.number
rstAux.fields(3).value=err.description
rstAux.update
'Case otro número de error. Copias lo anterior (en negrita)
'Y todos los case como errores quieras gestionar
END SELECT
Goto Siguiente:
End Sub

Bueno... Te lo he escrito de cabeza y espero que no haya ningún error de sintaxis.

A ver si te funciona.

Un saludo,


http://neckkito.siliconproject.com.ar

Hola!

Para evitar "sustos" cambia la última parte del código así:

Exit Sub
sol_err:
SELECT CASE err.number
CASE 94
rstAux.addnew
rstAux.fields(0).value=rst.Fields("IdentificadorDeTuTabla").value
rstAux.fields(1).value=rst.Fields("CampoConflictivo").value
rstAux.fields(2).value=err.number
rstAux.fields(3).value=err.description
rstAux.update
'Case otro número de error. Copias lo anterior (en negrita)
'Y todos los case como errores quieras gestionar
CASE ELSE 'Este siempre el último
msgbox "Se ha producido el error " & err.number & " - " & err.description & vbcrlf _
& "Este error no se ha gestionado",vbinformation, "ERROR"
END SELECT
Goto Siguiente:
End Sub

Vale entiendo como lo has echo, ahora te pego el codigo, a ver como lo ves, ya que me fda el error en un modulo.

Tengo el modulo :

Function CorreuHTML(Dir As String, CC As String, Asunto As String, TextoMsg As String, Optional AttachmentPath, Optional AttachmentPath2)
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)

With OutMail
.To = Dir
.CC = CC
.BCC = ""
.Subject = Asunto
.Body = .HTMLBody
.BodyFormat = olFormatHTML
.HTMLBody = TextoMsg

'Se pueden adjuntar ficheros
If Not IsMissing(AttachmentPath) Then
.Attachments.Add (AttachmentPath)
End If
'Es poden adjuntar 2 adjunts
If Not IsMissing(AttachmentPath2) Then
.Attachments.Add (AttachmentPath2)
End If
.Send
'.Display 'tambien se puede usar .Send y lo situa en la bandeja de salida
End With

Set OutMail = Nothing
Set OutApp = Nothing

End Function

Que es llamado por el boton

Private Sub Correu_HTML_Click()

Dim BaseDeDades As Database
Dim Consulta As QueryDef
Dim RegistreTemporal As DAO.Recordset
Dim TaulaOrigen As String
Dim Correu As String
Dim Nom As String
Dim Fitxa As String
Dim identificador As Long

Set BaseDeDades = CurrentDb
TaulaOrigen = "SELECT * FROM TablaManual"
Set RegistreTemporal = CurrentDb.OpenRecordset(TaulaOrigen, dbOpenDynaset)
If RegistreTemporal.EOF = False Then
RegistreTemporal.MoveLast
RegistreTemporal.MoveFirst
Do Until RegistreTemporal.EOF
BaseDeDades.QueryDefs.Delete ("ConsultaCorreo")
identificador = RegistreTemporal!IdRegistre
Set Consulta = BaseDeDades.CreateQueryDef("ConsultaCorreo", _
"SELECT * FROM TablaManual WHERE TablaManual.Ficha = " & identificador)
Correu = RegistreTemporal!Email
Nom = RegistreTemporal!Nombre
Fitxa = RegistreTemporal!Ficha

CorreuHTML Correu, "", Assumpte, Missatge

RegistreTemporal.MoveNext
Loop
End If
BaseDeDades.Close
RegistreTemporal.Close

End Sub

Y el error me lo da en el .Send del modulo, cuando Outlook comprueba la dirección de correo y peta cuando encuentra un fulanito@@dominio.com, o errores varios de sintaxis.

Como lo ves?

¿Qué número de error te da?

Se ha producido el error '-2147467259 (80004005)' en tiempo de ejecución:
Outlook no reconoce alguno de los nombres.

Esto salta cuando he puesto direccion@@dominio.com

El codigo que te he puesto, esta medio traducido al catalán, si tienes alguna duda te cambio los campos :)

Gracias!

Hola!

Por el número de error me da la sensación que estás empleando un sistema de 64 bits... "Chungo", porque si la cosa no fuera bien no puedo hacer pruebas (el mío es de 32 bits).

Como desconozco si el funcionamiento será igual voy a cambiarte el procedimiento por un procedimiento "reducido". Si lo quieres hacer más complicado tendrás que hacer tú las pruebas.

Creas, como te comentaba, una tabla llamada TAux, pero sólo con un campo tipo texto (si las direcciones de correo son muy largas puedes definirlo como memo). Algo así como [MailMal]

Si quieres haz una prueba en una copia de tu BD, por si las moscas.

Te copio tus códigos, indicándote en negrita las modificaciones, a ver si así te funciona :

Function CorreuHTML(Dir As String, CC As String, Asunto As String, TextoMsg As String, Optional AttachmentPath, Optional AttachmentPath2)
On error goto sol_err
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem

Dim rst as DAO.Recordset
Set rst=currentdb.openrecordset("TAux",dbOpenTable)

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)

With OutMail
.To = Dir
.CC = CC
.BCC = ""
.Subject = Asunto
.Body = .HTMLBody
.BodyFormat = olFormatHTML
.HTMLBody = TextoMsg

'Se pueden adjuntar ficheros
If Not IsMissing(AttachmentPath) Then
.Attachments.Add (AttachmentPath)
End If
'Es poden adjuntar 2 adjunts
If Not IsMissing(AttachmentPath2) Then
.Attachments.Add (AttachmentPath2)
End If
.Send
'.Display 'tambien se puede usar .Send y lo situa en la bandeja de salida
End With

Set OutMail = Nothing
Set OutApp = Nothing

Exit function
sol_err:
With rst
.Addnew
.fields(0).value=Dir
.update
end with

End Function

Que es llamado por el boton

Private Sub Correu_HTML_Click()

Dim BaseDeDades As Database
Dim Consulta As QueryDef
Dim RegistreTemporal As DAO.Recordset
Dim TaulaOrigen As String
Dim Correu As String
Dim Nom As String
Dim Fitxa As String
Dim identificador As Long

docmd.setwarnings false
docmd.runSQL("DELETE FROM TAux")
docmd.setwarnings true

Set BaseDeDades = CurrentDb
TaulaOrigen = "SELECT * FROM TablaManual"
Set RegistreTemporal = CurrentDb.OpenRecordset(TaulaOrigen, dbOpenDynaset)
If RegistreTemporal.EOF = False Then
RegistreTemporal.MoveLast
RegistreTemporal.MoveFirst
Do Until RegistreTemporal.EOF
BaseDeDades.QueryDefs.Delete ("ConsultaCorreo")
identificador = RegistreTemporal!IdRegistre
Set Consulta = BaseDeDades.CreateQueryDef("ConsultaCorreo", _
"SELECT * FROM TablaManual WHERE TablaManual.Ficha = " & identificador)
Correu = RegistreTemporal!Email
Nom = RegistreTemporal!Nombre
Fitxa = RegistreTemporal!Ficha

CorreuHTML Correu, "", Assumpte, Missatge

RegistreTemporal.MoveNext
Loop
End If
BaseDeDades.Close
RegistreTemporal.Close

End Sub

A ver si con esto hace lo que pides. Si no me vuelves a comentar, indicándome el máximo de detalles sobre el hipotético error que pudiera producirse.

Saludos,

Neckkito

Tiene buena pinta :P
Ahora lo pruebo.

La cosa es que lo programo en una maquina con Win XP y Office 2003
Pero lo ejecuto en mi maquina principal con Windows 7 y Office 2010 64 bit.

Si tuviese que hacerlo en 32, no habría problema.
Voy a ver si funciona, que es algo que me da "bastante por culo" el tener que depurar cada vez.

Te cuento :)

De momento, acabo de probar modificando el Office 2010 y funciona a la perfección!!!

Muchísimas gracias!!!

No sabes la faena que me quitas de encima, todo por culpa de ser un programador chungo jajajaja

PD: Te importe que use el código para explicar en mi blog el proceso? Te menciono en el post como más te interese :)

Bueno... pues la verdad es que me alegra muchísimo que te haya funcionado bien.

Sólo comentarte, por ser purista, que lo ideal hubiera sido definir el control de errores de la manera siguiente:

sol_err:
If err.number=-2147... then
'el código que te añade los registros a TAux
Else
msgbox "Se ha producido el error " & err.number & " - " & err.description
End if
End function

Simplemente porque si se produce algún otro error diferente al de la sintaxis en la dirección de mail el programa te funcionaría mal y no sabrías por qué. Pero dado que tú tienes los elementos necesarios pues puedes hacer las pruebas que consideres oportunas para discriminar errores.

Y, evidentemente, no hay problema para que utilices la solución en el blog. Si me quieres mencionar pues mejor, así me haces "publicidad gratuita"... je, je... Sin problemas.

Una salutació ben cordial,

Neckkito

Claro, sería lo suyo, aunque no tengo ningun On Error Goto, con lo que cualquier error lo depuro y veo de donde viene.

Como no es una aplicación para usuario final.
Aunque ya pienso en formas de poder hacer lo que me comentas de forma que sea totalmente "User friendly"

Iré dándole vueltas.

No tardaré en plantearte alguna otra cuestión, que tengo que informatizar las facturas según la nueva normativa Factura-e española... xml, certificados digital....

Y por otro lado el tema de compilar la aplicación para que no toquen el código.

Hablamos :)