Código que no funciona para enviar mail VBA

Quisiera saber por qué al momento de correr el código siguiente, luego de demorarse bastante tiempo, me arroja error de tipo: supera capacidad.

Mi idea es que el código vaya revisando en una hoja llamada "tableau de donné" distintas fechas que están en la columna DE y en las filas a partir de la 2. Esta fecha cada vez sera comparada a la fecha ingresada en la fila 1 columna G de la hoja "Mail" y si corresponde a la misma fecha, quiero que agregue el numero de "OF" (buscado en la misma fila donde encontró la coincidencia y en la columna B)dentro del mail que estoy escribiendo.

El código que escribí es el siguiente:

Sub EnvoyerMail()
Dim OutlookApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim Sujet As String
Dim Dest As String
Dim Message As String
Dim ligne As Long
Dim cont As Date
Dim fecha As Date
Dim OF As String

    Set OutlookApp = New Outlook.Application
    Sujet = "Liste OF à imprimer"
    Dest = Sheets("Mail").Cells(2, 7) 'mail destinataire
    Message = "Caroline, j'ai besoin d'imprimmer les étiquettes correspondant aux OF suivants:"
    ligne = 2
    cont = Sheets("Tableau de donné").Cells(ligne, 4)
    fecha = Sheets("Mail").Cells(1, 7)
    While cont <> Empty
    If (fecha = cont) Then
        OF = Sheets("Tableau de donné").Cells(ligne, 2).Value
        Message = Message & vbNewLine & OF
    End If
    ligne = ligne + 1
    Wend
    Message = Message & vbNewLine & vbNewLine
    Message = Message & "Cordialement"

    Set MItem = OutlookApp.CreateItem(olMailItem)
    With Item
        .To = Dest
        .CC = ""
        .BCC = ""
        .Subject = Sujet
        .Body = Message
End With
End Sub

Respuesta
1

Prueba este código...

Lo que hice fue sustituir el bucle de While...Wend (que a mi no me gusta para nada, lo evito siempre que puedo) por un For Each...Next

También cambé un poco algunas partes del procedimiento que en mi opinión podían mejorarse.

No tengo outlook en esta PC, no lo pude probar, pero debería funcionar. De todas formas yo no uso Outlook para mandar emails por VBA, prefiero usar CDO.

Este es el código:

Sub EnvoyerMail()
'variables del objeto outlook
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
'variables para la busqueda de la fecha
Dim Mail As Worksheet: Set Mail = Sheets("Mail")
Dim TableauDeDonne As Worksheet: Set TableauDeDonne = Sheets("tableau de donné")
Dim MailDate As Date: MailDate = Mail.Range("G1").Value
Dim rCell As Range, rRng As Range
Dim uF As Long: uF = TableauDeDonne.Range("DE" & Rows.Count).End(xlUp).Row
Set rRng = TableauDeDonne.Range("DE2:DE" & uF)
'variables para el email
Dim Dest As String: Dest = Mail.Cells(2, 7)
Dim OF As String
Dim Messg As String: Messg = "Caroline, j'ai besoin d'imprimmer les étiquettes correspondant aux OF suivants:"
For Each rCell In rRng.Cells
    If rCell.Value = MailDate Then
        OF = OF & vbCr & TableauDeDonne.Cells(rCell.Row, 2)
    End If
Next rCell
Messg = Messg & OF & vbCr & vbCr & "Cordialement"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
    .To = Dest
    .CC = ""
    .BCC = ""
    .Subject = "Liste OF à imprimer"
    .Body = Messg
    .Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Andy

Muchísimas gracias !

Funciona perfecto :)

Una ultima consulta, ¿cómo podría hacer para que se escriba automático el mail pero que no se envíe directamente? ¿Si no que me deje abierto el mail por si quiero agregar algo más? ¿solo saco el .Send?

Gracias de nuevo

Cambia .Send por .Display

Si mal no recuerdo eso hace lo que quieres.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas