Макрос для пропуска пустых ячеек и окончания (Кнопка для отправки электронных писем) - PullRequest
Новая
       75

Макрос для пропуска пустых ячеек и окончания (Кнопка для отправки электронных писем)

0 голосов
/ 22 февраля 2020

У меня проблема с макросом, который я использую для автоматической отправки электронных писем с помощью кнопки ... Я не эксперт, поэтому я ищу вашу помощь ? (это сводит меня с ума ... и кстати Я говорю по-испански sh)

Макрос выглядит следующим образом: 

Sub Enviar_Correo2()
'
' Enviar_Correo2
' Enviar por correo electrónico automáticamente el resumen ejecutivo del trabajo de los Equipos de Mejora Continua
'Seleccionamos el rango de celdas a enviar Select

ThisWorkbook.Sheets("Resumen ejecutivo").Range("$A$1:$K$52").Select
For I = 1 To 10
'El valor de i se pone en la celda F18 para que con BUSCARV se devuelvan
'los datos correspondientes al ID.
ThisWorkbook.Sheets("Configuraciones iniciales").Range("F18").Value = I
'Mostramos la sección para enviar correo.
ActiveWorkbook.EnvelopeVisible = True
'Llamamos al envío...
With ActiveSheet.MailEnvelope
.Item.To = ThisWorkbook.Sheets("Configuraciones iniciales").Range("$B$19").Value
'.Item.cc = "correo1@dominio.com" 'con copia a...
'.Item.bcc = "correo2@dominio.com" 'con copia oculta a...
.Item.Subject = "PROPUESTA DE TEMAS PARA APROBACIÓN GERENCIAL"
.Introduction = "Estimados Srs.: Por medio de la presente nos permitimos plantear a Ustedes los siguientes tres temas seleccionados por nuestro Equipo de Mejora Continua, con la finalidad que nos asignen uno para iniciar su estudio. Estamos seguros que el trabajo a realizar sera un aporte valioso para nuestra empresa."
.Item.Send
End With
Next I
End Sub

В этом макросе я хочу отправить диапазон ячеек из листа "Resumen ejecutivo" максимум 10 электронных писем, локализованных на другом листе под названием «Configuraciones iniciales». Проблема в том, что когда пользователь не заполняет весь столбец, который пронумерован от 1 до 10. Я имею в виду не заполнять таблицу 10 электронными письмами. Если этого не произойдет, то в последнем сообщении макрос повторяется столько раз, пока не будет завершено 10 электронных писем или как если бы оно было отправлено на 10 электронных писем. Я надеюсь, что вы меня понимаете.

Итак, я хочу поместить где-то в этом макросе оператор, чтобы пропустить пустые ячейки без адресов электронной почты в столбце с номерами от 1 до 10 и завершить действие sh отправки электронных писем.

enter image description here

1 Ответ

0 голосов
/ 22 февраля 2020

Мне было трудно разобраться в вашем коде. Вот смысл, который я сделал. Пожалуйста, прочитайте мои комментарии. Они написаны без понимания того, что уже существует в коде. 

Option Explicit

Sub Enviar_Correo2()
    ' Enviar_Correo2
    ' Enviar por correo electrónico automáticamente el resumen ejecutivo del trabajo
    ' de los Equipos de Mejora Continua

    Dim i As Integer
    Dim Recipient As String

    ' Seleccionamos el rango de celdas a enviar Select
    ' it's not clear why this range is being selected
    ThisWorkbook.Sheets("Resumen ejecutivo").Range("$A$1:$K$52").Select

    For i = 0 To 9
        With ThisWorkbook.Sheets("Configuraciones iniciales")
            ' assign the value of B19 to B28 as recipient
            Recipient = Trim(.Cells(19 + i, "B").Value)
            ' skip the following if the cell is blank
            If Len(Recipient) Then
                ' El valor de i se pone en la celda F18 para que con BUSCARV
                ' se devuelvan los datos correspondientes al ID.
                ' not clear why you would want to write a different number to the
                ' same cell on each loop
                .Range("F18").Value = i + 1

                'Mostramos la sección para enviar correo.
                ActiveWorkbook.EnvelopeVisible = True
                'Llamamos al envío...
                With ActiveSheet.MailEnvelope
                    .Item.To = Recipient
                    '.Item.cc = "correo1@dominio.com" 'con copia a...
                    '.Item.bcc = "correo2@dominio.com" 'con copia oculta a...
                    .Item.Subject = "PROPUESTA DE TEMAS PARA APROBACIÓN GERENCIAL"
                    .Introduction = "Estimados Srs.: Por medio de la presente nos permitimos plantear " & _
                                    "a Ustedes los siguientes tres temas seleccionados por nuestro " & _
                                    "Equipo de Mejora Continua, con la finalidad que nos asignen uno " & _
                                    "para iniciar su estudio. Estamos seguros que el trabajo a realizar " & _
                                    "sera un aporte valioso para nuestra empresa."
                    .Item.Send
                End With
            End If
        End With
    Next i
End Sub

Я думаю, что приведенный выше код должен быть не хуже оригинала, но он может содержать некоторые мысли, которые помогут вам построить то, что вы действительно хотите .

...