Cita de Luis Morel-user en 8 de noviembre de 2023, 22:18

Como puedo hacer para que este codigo obvie las celdas en blanco y solo elija los correos de las celdas que contengan

Sub EnviarEmail()

Dim OutlookApp As Outlook.Application
Dim MItem As Outlook.MailItem
Dim CeldaCorreo As Range
Dim Asunto As String
Dim Correo As String
Dim Destinatario As String
Dim Quincena As String
Dim Msg As String
Dim SV As String
Dim HE As String
Dim Vac As String
Dim HE15 As String
Dim HE35 As String
Dim HE100 As String
Dim THE As String
Dim BONO As String
Dim IG As String
Dim IT As String
Dim AFP As String
Dim SFS As String
Dim ISR As String
Dim CXC As String
Dim CXCs As String
Dim SM As String
Dim RGV As String

Set OutlookApp = New Outlook.Application

For Each CeldaCorreo In Range("E8:E143")

Asunto = "Nomina"
Destinatario = CeldaCorreo.Offset(0, -1).Value
Correo = CeldaCorreo.Value
Quincena = Format(CeldaCorreo.Offset(0, 36).Value, "$#,##.##0")
SV = Format(CeldaCorreo.Offset(0, 6).Value, "$#,##0")
HE = Format(CeldaCorreo.Offset(0, 7).Value, "$#,##0")
Vac = Format(CeldaCorreo.Offset(0, 8).Value, "$#,##0")
IG = Format(CeldaCorreo.Offset(0, 10).Value, "$#,##0")
HE15 = Format(CeldaCorreo.Offset(0, 12).Value, "$#,##0")
HE35 = Format(CeldaCorreo.Offset(0, 14).Value, "$#,##0")
HE100 = Format(CeldaCorreo.Offset(0, 16).Value, "$#,##0")
THE = Format(CeldaCorreo.Offset(0, 17).Value, "$#,##0")
IT = Format(CeldaCorreo.Offset(0, 18).Value, "$#,##0")
BONO = Format(CeldaCorreo.Offset(0, 19).Value, "$#,##0")
AFP = Format(CeldaCorreo.Offset(0, 27).Value, "$#,##0")
SFS = Format(CeldaCorreo.Offset(0, 28).Value, "$#,##0")
ISR = Format(CeldaCorreo.Offset(0, 30).Value, "$#,##0")
CXC = Format(CeldaCorreo.Offset(0, 31).Value, "$#,##0")
CXCs = Format(CeldaCorreo.Offset(0, 32).Value, "$#,##0")
SM = Format(CeldaCorreo.Offset(0, 33).Value, "$#,##0")
RGV = Format(CeldaCorreo.Offset(0, 34).Value, "$#,##0")

Msg = "Estimado " & Destinatario & vbNewLine & vbNewLine
Msg = Msg & "Queremos Informarle que su Nomina para 2da quincena del mes en curso fue depositada " & vbNewLine & vbNewLine
Msg = Msg & "Desglose: " & vbNewLine & vbNewLine
Msg = Msg & "Descuento por AFP: " & AFP & vbNewLine
Msg = Msg & "Descuento Por SFS : " & SFS & vbNewLine
Msg = Msg & "Descuento Por ISR : " & ISR & vbNewLine
Msg = Msg & "Descuento Por Cuentas Por Cobrar : " & vbNewLine
Msg = Msg & "Descuento Por Cuentas por Cobrar Especiales : " & vbNewLine
Msg = Msg & "Descuento Por Seguro Medico : " & vbNewLine
Msg = Msg & "Descuento Por Reembolso Gastos Varios : " & vbNewLine
Msg = Msg & "Sueldo Vacaciones :" & SV & vbNewLine
Msg = Msg & "Horas Extra : " & HE & vbNewLine
Msg = Msg & "Vacaciones : " & Vac & vbNewLine
Msg = Msg & "Incentivos y/o Guardias : " & IG & vbNewLine
Msg = Msg & "Monto por Horas Extras al 15% " & HE15 & vbNewLine
Msg = Msg & "Monto por Horas Extras al 35% " & HE35 & vbNewLine
Msg = Msg & "Monto por Horas Extras al 100% " & HE100 & vbNewLine
Msg = Msg & "Total en $ de horas extras persividas : " & THE & vbNewLine
Msg = Msg & "Incentivo Por Transporte : " & IT & vbNewLine
Nsg = Msg & "Bonificacion : " & BONO & vbNewLine
Msg = Msg & " Para un total percibido de : " & Quincena & vbNewLine & vbNewLine
Msg = Msg & "Atentamente:" & vbNewLine & vbNewLine
Msg = Msg & "Dept. de Nomina."

Set MItem = Outlook.CreateItem(olMailItem)
With MItem
.To = Correo
.Subject = Asunto
.Body = Msg
.Send

End With

Next

End Sub