Visual Basic - Ayuda con código vba

Life is soft - evento anual de software empresarial

Pos: 58

Val: 25

Ayuda con código vba

Publicado por Alberto (13 intervenciones) el 04/02/2019 19:42:56

Buenas a todos!!

Estoy intentando crear una macro en un formulario pero algo ando perdido y ruego si alguien pudiera revisarmelo.

La idea es: Sobre una consulta que se realiza "llamada Envio primera reclamacion" quiero que se realice el envío de un mail a cada uno de los mails de la lista.
El problema me viene porque es para reclamar unos documentos, cada correo va a solicitar una documentación diferente, dependiendo de unos checkbox que tienen que marcar previamente al registrarlo en la tabla, de forma que dependiendo de lo marcado va a añadir una linea más al mail u otra, quedando el resto del mail igual.

Este es el código:

Option Compare Database

Private Sub Enviar_Email_Envio_Primera_Reclamacion(Usuario, NUMERO_DE_CONTRATO, Oficina, CLIENTE, FECHA_1_RECLAMACION, Contrato, ccm, seguro, garantia_recompra, ENVIO_RENT_and_TECH)
On Error GoTo Err_CORREO_Click
Dim dbs As Database, qdf As QueryDef, consulta As String
Dim cuerpo As String, para As String, cc As String, asunto As String
Dim comentario As String
Dim Contrato As String
Dim ccm As String
Dim garantia_recompra As String
Dim seguro As String

asunto = "PRIMERA RECLAMACIÓN DE DOCUMENTACIÓN ORIGINAL"

texto = "Buenos días," & _
(Chr(10)) + (Chr(10)) + "Desde el departamento de Archivo de no hemos recibido documentación contractual asociada al siguiente contrato:" & _
If Contrato is True Then (Chr(10)) + (Chr(10)) + "Necesitamos copia del contrato" & _
If ccm is True Then (Chr(10)) + (Chr(10)) + "Necesitamos copia del ccm" & _
If garantia_recompra is True Then (Chr(10)) + (Chr(10)) + "Necesitamos copia del la garantia" & _
If seguro is True Then (Chr(10)) + (Chr(10)) + "Necesitamos copia del seguro" & _
(Chr(10)) + (Chr(10)) + "Con el fin de poder llevar a cabo su correcto tratamiento necesitamos...:" & _
(Chr(10)) + (Chr(10)) + "Nos remitan los documentos de XXXX." & _
(Chr(10)) + (Chr(10)) + (Chr(10)) + "Gracias, " & _
(Chr(10)) + (Chr(10)) + (Chr(10)) + "Un saludo, " & _
(Chr(10)) + (Chr(10)) + (Chr(10)) + "Productos" & _
(Chr(10)) + "Departamento de reclamaciones." 'MsgBox texto

If IsNull(Usuario) Then
MsgBox "No existe Email de Usuario para la operación: " + BANCO + "-" + Oficina + "-" + CONTR + "-" + FOLIO
GoTo Exit_CORREO_Click::
End If

Set miCorreo = CreateObject("CDO.Message")

With miCorreo

'.from = "mail de correo" & "< >"

.from = "mail de correo & "<mail de correo>"
'.from = "mail de correo"
.To = Usuario
.Bcc = "mail de correo"
.replyto = "mail de correo"

.Subject = asunto
.TextBody = texto
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = _
"smt"
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Update
'.display
.Send
End With

Set miCorreo = Nothing

Exit_CORREO_Click:
Exit Sub

Err_CORREO_Click:
MsgBox Err.Description
Resume Exit_CORREO_Click
End Sub

Agradecería enormemente si alguien puede echarme un cable con esto. He omitido los mails por simple LOPD, donde estoy atragantado es en los checkbox y añadir la linea al correo dependiendo de si están marcados o no.

Cuando lo intento me da el error "se esperaba expresión". Seguro que es lo mas tonto del mundo pero entre que estoy aprendiendo solo y que se me está haciendo eterno...
Muchisimas gracias de antemano!!

Un saludo.

Valora esta pregunta

Me gusta: Está pregunta es útil y esta clara

No me gusta: Está pregunta no esta clara o no es útil

Responder

Pos: 2

Val: 1.259

Ayuda con código vba

Publicado por Antoni Masana (558 intervenciones) el 05/02/2019 07:44:45

Mira si esto te sirve

Option Compare Database

Private Sub Enviar_Email_Envio_Primera_Reclamacion(Usuario, _

                                                   NUMERO_DE_CONTRATO, _

                                                   Oficina, _

                                                   CLIENTE, _

                                                   FECHA_1_RECLAMACION, _

                                                   Contrato, _

                                                   ccm, _

                                                   seguro, _

                                                   garantia_recompra, _

                                                   ENVIO_RENT_and_TECH)

    On Error GoTo Err_CORREO_Click

    Dim dbs As Database, qdf As QueryDef, consulta As String

    Dim cuerpo As String, para As String, cc As String, asunto As String

    Dim comentario As String

    Dim Contrato As String

    Dim ccm As String, garantia_recompra As String, seguro As String, _

        Anexo_1 as String, Anexo_2 as String, _

        Anexo_3 as String, Anexo_4 as String

    Anexo_1 = ""

    Anexo_2 = ""

    Anexo_3 = ""

    Anexo_4 = ""

    If Contrato Then

        Anexo_1 = VbCr & VbCr + "Necesitamos copia del contrato"

    End If

    If ccm is True Then

        Anexo_2 = VbCr & VbCr + "Necesitamos copia del ccm"

    End If

    If garantia_recompra Then

         Anexo_3 = VbCr & VbCr + "Necesitamos copia del la garantia"

    End If

    If seguro  Then

        Anexo_4 = VbCr & VbCr + "Necesitamos copia del seguro"

    End If

    asunto = "PRIMERA RECLAMACIÓN DE DOCUMENTACIÓN ORIGINAL"

    texto = "Buenos días," & VbCr & VbCr + _

            "Desde el departamento de Archivo de no hemos recibido " & _

            "documentación contractual asociada al siguiente contrato:" & _

            Anexo_1 & Anexo_2 & Anexo_3 & Anexo_4 & _

            VbCr & VbCr + "Con el fin de poder llevar a cabo su correcto tratamiento necesitamos...:" & _

            VbCr & VbCr + "Nos remitan los documentos de XXXX." & _

            VbCr & VbCr + VbCr &  "Gracias, " & _

            VbCr & VbCr + VbCr &  "Un saludo, " & _

            VbCr & VbCr + VbCr &  "Productos" & _

            VbCr & "Departamento de reclamaciones." 'MsgBox texto

    If IsNull(Usuario) Then

        MsgBox "No existe Email de Usuario para la operación: " + BANCO + "-" + Oficina + "-" + CONTR + "-" + FOLIO

        GoTo Exit_CORREO_Click::

    End If

    Set miCorreo = CreateObject("CDO.Message")

    With miCorreo

        '.from = "mail de correo" & "< >"

        .from = "mail de correo & "<mail de correo>"

        '.from = "mail de correo"

        .To = Usuario

        .Bcc = "mail de correo"

        .replyto = "mail de correo"

        .Subject = asunto

        .TextBody = texto

        .Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2

        .Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smt"

        .Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25

        .Configuration.Fields.Update

        '.display

        .Send

    End With

    Set miCorreo = Nothing

Exit_CORREO_Click:

    Exit Sub

Err_CORREO_Click:

    MsgBox Err.Description

    Resume Exit_CORREO_Click

End Sub

Saludos.
\\//_

Valora esta respuesta

Me gusta: Está respuesta es útil y esta clara

No me gusta: Está respuesta no esta clara o no es útil

Comentar

Pos: 58

Val: 25

Ayuda con código vba

Publicado por Alberto (13 intervenciones) el 05/02/2019 14:15:59

Mil gracias!, he añadido el código y lo he modificado con las direcciones, voy a terminar la macro y volveré para responderte si está todo ok.

Independientemente, muy agradecido por la ayuda.

Un saludo.
Alberto.

Valora esta respuesta

Comentar

Pos: 58

Val: 25

Ayuda con código vba

Publicado por Alberto (13 intervenciones) el 06/02/2019 14:27:41

Pues después de un par de días liadisimo he podido ponerme, pero no consigo saber si el código es válido o no, ya que al ejecutar el comando me da un error.

Error de compilacion: El argumento no es opcional

Codigo:

Private Sub Comando60_DblClick(Cancel As Integer)

On Error GoTo Err_Buscar_Click

    Dim dbs As Database, consulta As String, fechadesde As String, fechahasta As String

    Dim rs As Recordset

    MsgBox "Se va a proceder al envío de 1ª Reclamación, ¿Continuar?", vbYesNo + vbExclamation, "Atención"

 consulta = "SELECT * FROM EnvioPrimeraReclamacion;"

    Set dbs = CurrentDb

    Set rs_previa = dbs.OpenRecordset(consulta)

    NUMERO_DE_CONTRATO = rs_previa("Fol").Value

    rs_previa.MoveFirst

    Do Until rs_previa.EOF = True

        Enviar_Email_EnvioPrimeraReclamacion rs_previa("NUMERO_DE_CONTRATO").Value, rs_previa("OFICINA").Value, rs_previa("CLIENTE").Value, rs_previa("FECHA_1_RECLAMACION").Value, rs_previa("CONTRATO").Value, rs_previa("CCM").Value, rs_previa("SEGURO").Value, rs_previa("GARANTIA_RECOMPRA").Value, rs_previa("ENVIO_RENT_and_TECH").Value

        Me.[FECHA_1_RECLAMACION].Value = Date

        rs_previa.MoveNext

    Loop

    rs_previa.Close

    dbs.Close

    MsgBox "Correos Enviados Correctamente."

    Exit Sub

Err_Buscar_Click:

    MsgBox Err.Description

End Sub

Ando buscando dónde está el error para comprobar que sale bien.

Un saludo y muchisimas gracias de antemano.
Alberto.

Valora esta respuesta

Comentar

Pos: 2

Val: 1.259

Ayuda con código vba

Publicado por Antoni Masana (558 intervenciones) el 06/02/2019 14:52:18

Aunque en principio no veo ninguna causa de error por sintaxis si veo dos cosas:

* Primera: Empezar un procedimiento con un ON ERROR ya es por si un error de programador, si lo pones nunca sabrás donde esta el error.

* Segunda: que significa la línea 13, porque NUMERO_DE_CONTRATO `para el compilador es una variable local no definida.

Private Sub Comando60_DblClick(Cancel As Integer)

    On Error GoTo Err_Buscar_Click

    Dim dbs As Database, consulta As String

    Dim rs As Recordset

    MsgBox "Se va a proceder al envío de 1ª Reclamación, ¿Continuar?", vbYesNo + vbExclamation, "Atención"

    consulta = "SELECT * FROM EnvioPrimeraReclamacion;"

    Set dbs = CurrentDb

    Set rs_previa = dbs.OpenRecordset(consulta)

    NUMERO_DE_CONTRATO = rs_previa("Fol").Value

    rs_previa.MoveFirst

    Do Until rs_previa.EOF = True

        Enviar_Email_EnvioPrimeraReclamacion rs_previa("NUMERO_DE_CONTRATO").Value, _

                                             rs_previa("OFICINA").Value, _

                                             rs_previa("CLIENTE").Value, _

                                             rs_previa("FECHA_1_RECLAMACION").Value, _

                                             rs_previa("CONTRATO").Value, _

                                             rs_previa("CCM").Value, _

                                             rs_previa("SEGURO").Value, _

                                             rs_previa("GARANTIA_RECOMPRA").Value, _

                                             rs_previa("ENVIO_RENT_and_TECH").Value

        Me.[FECHA_1_RECLAMACION].Value = Date

        rs_previa.MoveNext

    Loop

    rs_previa.Close

    dbs.Close

    MsgBox "Correos Enviados Correctamente."

    Exit Sub

Err_Buscar_Click:

    MsgBox Err.Description

End Sub

Saludos.
\\//_

Valora esta respuesta

Comentar

Pos: 58

Val: 25

Ayuda con código vba

Publicado por Alberto (13 intervenciones) el 06/02/2019 14:55:12

He encontrado el error, estaba aqui

Private Sub Enviar_Email_Envio_Primera_Reclamacion(Usuario, _

                                                   NUMERO_DE_CONTRATO, _

                                                   Oficina, _

                                                   CLIENTE, _

                                                   FECHA_1_RECLAMACION, _

                                                   Contrato, _

                                                   ccm, _

                                                   seguro, _

                                                   garantia_recompra, _

                                                   ENVIO_RENT_and_TECH)

No tengo ningun "Usuario" por lo que al quitarlo, me avanzaba sin problema, sin embargo ahora me encuentro con otro error.

"No se encontró el elemento en esta colección.

y no me permite continuar. He comprobado y no encuentro nada raro, si es cierto que en la tabla/consulta, el campo "fecha_1_reclamacion" está en blanco (es más quiero añadir la fecha del "dia de hoy" cuando se ejecute), pero entiendo eso no es lo que falla, no?.

Ahora si ando algo perdido, Alguien me lo podría revisar?.

Un saludo.
Alberto.

Valora esta respuesta

Comentar

Pos: 58

Val: 25

Ayuda con código vba

Publicado por Alberto (13 intervenciones) el 07/02/2019 12:08:25

Buenos días Antoni.

Primero y de verdad gracias por la ayuda que me has prestado con el código.

He quitado el procedimiento ON error, para ejecutar y ver dónde me está dando fallo.
Y me lo está dando en la linea 13 que me me comentas.

Private Sub Comando60_DblClick(Cancel As Integer)

Dim dbs As Database, consulta As String, fechadesde As String, fechahasta As String
Dim rs As Recordset

MsgBox "Se va a proceder al envío de 1ª Reclamación, ¿Continuar?", vbYesNo + vbExclamation, "Atención"

consulta = "SELECT * FROM EnvioPrimeraReclamacion;"
Set dbs = CurrentDb
Set rs_previa = dbs.OpenRecordset(consulta)

NUMERO_DE_CONTRATO = rs_previa("Fol").Value 'AQUI ME DA EL ERROR
rs_previa.MoveFirst
Do Until rs_previa.EOF = True

Enviar_Email_EnvioPrimeraReclamacion rs_previa("NUMERO_DE_CONTRATO").Value, rs_previa("OFICINA").Value, rs_previa("CLIENTE").Value, rs_previa("FECHA_1_RECLAMACION").Value, rs_previa("CONTRATO").Value, rs_previa("CCM").Value, rs_previa("SEGURO").Value, rs_previa("GARANTIA_RECOMPRA").Value, rs_previa("ENVIO_RENT_and_TECH").Value
Me.[FECHA_1_RECLAMACION].Value = Date

rs_previa.MoveNext
Loop

rs_previa.Close

dbs.Close

MsgBox "Correos Enviados Correctamente."

Exit Sub

Err_Buscar_Click:

MsgBox Err.Description

End Sub

Mi idea es la de que vaya pasando por cada una de las columnas, y en aquellas en las que el campo fecha 1 reclamación esté en blanco, envíe el correo del código anterior, y que posteriormente y antes de pasar a la siguiente columna me ponga la fecha de hoy , así hasta que estén todas enviadas y con fecha.

Quizá debería poner en esa fila 13 la fecha_1_reclamación ?? algo se me escapa ahi.

De nuevo gracias.
Alberto.

Valora esta respuesta

Comentar

Pos: 2

Val: 1.259

Ayuda con código vba

Publicado por Antoni Masana (558 intervenciones) el 07/02/2019 13:58:21

Para saber que causa el error vamos por partes

Primero: Esto funciona:

MsgBox rs_previa("Fol").Value

Y como supongo que funciona

¿Que es esto?

NUMERO_DE_CONTRATO

Saludos.
\\//_

Valora esta respuesta

Comentar

Pos: 58

Val: 25

Ayuda con código vba

Publicado por Alberto (13 intervenciones) el 07/02/2019 14:08:31

numero_de_contrato es en la consulta de donde se van a tomar los datos, la primera columna.

Gracias!.
Alberto.

Valora esta respuesta

Comentar

Pos: 58

Val: 25

Ayuda con código vba

Publicado por Alberto (13 intervenciones) el 07/02/2019 14:11:20

Por si sirve de ayuda: El código lo he reutilizado de uno (que ya está funcionando) y que copio a continuación.

Private Sub Comando73_DblClick(Cancel As Integer)

On Error GoTo Err_Buscar_Click

    Dim dbs As Database, consulta As String, fechadesde As String, fechahasta As String

    Dim rs As Recordset

 consulta = "SELECT * FROM 1ReclamColab;"

    Set dbs = CurrentDb

    Set rs_previa = dbs.OpenRecordset(consulta)

    nombre_cliente = rs_previa("Fol").Value

    rs_previa.MoveFirst

    Do Until rs_previa.EOF = True

        Enviar_Email_1ReclCol rs_previa("Email").Value, rs_previa("Banco").Value, rs_previa("Ofic").Value, rs_previa("Contr").Value, rs_previa("FOL").Value, rs_previa("ClieNombre").Value, rs_previa("ClApell1").Value, rs_previa("ClApell2").Value, rs_previa("Nif-Clie").Value, rs_previa("MARCA").Value, rs_previa("MODELO").Value, rs_previa("Matric/bastidor").Value

        rs_previa.MoveNext

    Loop

    rs_previa.Close

    dbs.Close

    MsgBox "Correos Enviados Correctamente."

    Exit Sub

Err_Buscar_Click:

    MsgBox Err.Description

End Sub

He intentado sustituir los campos por los de mi consulta, pero es evidente no lo estoy haciendo bien.

Un saludo.

Valora esta respuesta

Comentar

Pos: 58

Val: 25

Ayuda con código vba

Publicado por Alberto (13 intervenciones) el 08/02/2019 09:43:02

Buenos días.

He optado por volver a reescribir todo el código y no reutilizarlo , me ha quedado así.

Private Sub Comando60_DblClick(Cancel As Integer)

Dim rs As DAO.Recordset

If MsgBox("Se va a proceder al envío de 1ª Reclamación, ¿Continuar?", vbYesNo + vbExclamation, "Atención") = vbNo Then Exit Sub

Set rs = CurrentDb.OpenRecordset("SELECT * FROM Envio1Recl WHERE FECHA_1_RECLAMACION = isEmpty", , dbForwardOnly)
If rs.EOF Then
MsgBox "No hay registros pendientes de reclamar.", vbInformation, "Atención"
Else
Do Until rs.EOF
Enviar_Email_Envio1Recl rs("NUMERO DE CONTRATO"), rs("OFICINA"), rs("CLIENTE"), Date, rs("CONTRATO"), rs("CCM"), rs("SEGURO"), rs("GARANTIA RECOMPRA"), rs("ENVIO RENT and TECH"), rs("SITUACION")
rs.Edit
rs("FECHA_1_RECLAMACION") = Date
rs.Update
rs.MoveNext
Loop
MsgBox "Correos Enviados Correctamente.", vbInformation
End If

rs.Close
Set rs = Nothing

End Sub

Pero me da error "El número de argumentos es incorrecto o la asignación de propiedad no es válida" .

De el primer código que me facilitaste corregido modifiqué para llamarlo " Enviar_Email_Envio1Recl" dejando lo demás tal cual estaba.

Que puede ser?.
Gracias!!!

Alberto.

Valora esta respuesta

Comentar

Pos: 58

Val: 25

Ayuda con código vba

Publicado por Alberto (13 intervenciones) el 08/02/2019 10:22:09

Adjunto captura del error y donde se refleja el error

Error-2

Gracias!
Alberto.

Valora esta respuesta

Comentar

Pos: 58

Val: 25

Ayuda con código vba

Publicado por Alberto (13 intervenciones) el 10/02/2019 16:15:35

Continuo liado con esto, he ido avanzando y cambiando cosas:

1- He cambiado la linea de código para abrir la consulta sin que filtre por la fecha_1_reclamación (porque la consulta access ya tiene el filtro hecho).
2- He revisado los campos del Enviar_Email_EnvioPrimera para que sean coincidentes con la consulta que abro ya que sin querer había puesto alguno de más.

Al final el código lo tengo asi:

Private Sub Comando60_DblClick(Cancel As Integer)

    Dim rs As DAO.Recordset

    If MsgBox("Se va a proceder al envío de 1ª Reclamación, ¿Continuar?", vbYesNo + vbExclamation, "Atención") = vbNo Then Exit Sub

    Set rs = CurrentDb.OpenRecordset("Select * from [EnvioPrimera]")

    If rs.EOF Then

        MsgBox "No hay registros pendientes de reclamar.", vbInformation, "Atención"

    Else

        Do Until rs.EOF

            Enviar_Email_Envioprimera rs("NUMERO_DE_CONTRATO"), rs("OFICINA"), rs("FECHA_1_RECLAMACION"), rs("CONTRATO"), rs("CCM"), rs("SEGURO"), rs("GARANTIA_RECOMPRA"), rs("ENVIO_RENT_and_TECH")

            rs.Edit

            rs("FECHA_1_RECLAMACION") = Date

            rs.Update

            rs.MoveNext

        Loop

        MsgBox "Correos Enviados Correctamente.", vbInformation

    End If

    rs.Close

    Set rs = Nothing

End Sub

Me da un error 3265 en :

Enviar_Email_Envioprimera rs("NUMERO_DE_CONTRATO"), rs("OFICINA"), rs("FECHA_1_RECLAMACION"), rs("CONTRATO"), rs("CCM"), rs("SEGURO"), rs("GARANTIA_RECOMPRA"), rs("ENVIO_RENT_and_TECH")

Espero alguien teniendo este código, y el del correo que el Sr Antoni me propuso y que se encuentra en este mismo hilo, pueda decirme como dejarlo para que funcione.

Gracias!
Alberto.

Valora esta respuesta

Comentar

necesito corregir error de busqueda para cedula

CREAR UN CONTROL DE CUENTAS POR COBRAR