我在使用宏通过按钮自动发送电子邮件时遇到了问题...我不是专家,所以我正在寻找您的帮助😔(这使我发疯...顺便说一句,说西班牙语)
宏如下:
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 = "[email protected]" 'con copia a...
'.Item.bcc = "[email protected]" '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”到另一工作表“ Configuraciones iniciales”中本地化的最多10封电子邮件。问题是,当用户未填写从1到10的所有列时,我的意思是未在表格中填充10封电子邮件。如果这没有发生,则在最后一封电子邮件中,宏将重复多次,直到完成10封电子邮件或将其发送给10封电子邮件为止。希望你能理解我。
因此,我想在此宏的某处放置一条语句,以跳过从1到10的列中没有电子邮件地址的空白单元格,并完成发送电子邮件的操作。
我发现很难理解您的代码。这就是我的理解。请阅读我的评论。他们是在编写代码时没有了解代码中已经存在的代码的好处。
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 = "[email protected]" 'con copia a...
'.Item.bcc = "[email protected]" '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
我认为上面的代码应该不比原始代码差,但是它可能包含一些想法,可以帮助您构建真正想要的东西。