En Excel, tengo el siguiente código que envía correos electrónicos para cada celda que contiene una dirección de correo electrónico en la columna K.

Esto funcionaría excepto porque el encabezado de la tabla no es una dirección de correo electrónico, por lo que rompe el código. Traté de omitir el encabezado especificando "if cell.value = CONTACT METHOD, que es el texto del nombre del encabezado, luego ir a la siguiente celda"

Pero esto provoca un error "Siguiente sin para".

Sub Mail_small_Text_Outlook()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2013
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Columns("K").Cells.SpecialCells(xlCellTypeConstants)

    If cell.Value Like "*@*" Then
    finaladdress = cell.Value

    Else
    finaladdress = cell.Value & "@email.smsglobal.com"

        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = finaladdress
            .Subject = "Reminder"
            .Body = "Dear " & Cells(cell.Row, "A").Value _
                  & vbNewLine & vbNewLine & _
                    "Please contact us to discuss bringing " & _
                    "your account up to date"
            'You can add files also like this
            '.Attachments.Add ("C:\test.txt")
            .Display
        End With
        On Error GoTo 0
        Set OutMail = Nothing
    End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
0
Gallaxhar 27 ene. 2015 a las 21:25

2 respuestas

La mejor respuesta

Si su objetivo es omitir la celda K1 en la columna K , entonces:

For Each cell In Columns("K2:K" & Rows.Count).Cells.SpecialCells(xlCellTypeConstants)
1
Gary's Student 27 ene. 2015 a las 18:56

Puede incluir el código dentro del ciclo FOR/EACH dentro de una declaración IF separada, como se muestra a continuación:

Sub Mail_small_Text_Outlook()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2013
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Columns("K").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value = "CONTACT METHOD" Then
        'Do Nothing, or Enter code here
    Else
        If cell.Value Like "*@*" Then
        finaladdress = cell.Value

        Else
        finaladdress = cell.Value & "@email.smsglobal.com"

            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = finaladdress
                .Subject = "Reminder"
                .Body = "Dear " & Cells(cell.Row, "A").Value _
                      & vbNewLine & vbNewLine & _
                        "Please contact us to discuss bringing " & _
                        "your account up to date"
                'You can add files also like this
                '.Attachments.Add ("C:\test.txt")
                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub
0
basodre 27 ene. 2015 a las 18:36