Indica cuales son las celdas que pueden variar en este código
Me proporcionaron el siguiente código en VB para lograr enviar correos de acuerdo a una condición. En un rango de correos lista
El código funciona perfecto, sin embargo, el código se monto sobre un ejemplo sencillo, ahora necesito adaptarlo a una hoja más elabaroda en donde las posiciones de las celdas son distintas
NO logro distinguir en la lista de instrucciones cuales son las celdas que puedo variar para ajustarlo a la otra hoja.
Sub Macro68()
'------------------
'by Cacho Rodríguez
'------------------
Dim LD(), C As Range, Q%
For Each C In ActiveSheet.ListObjects(1).DataBodyRange.Columns(2).Cells
If InStr(LCase(C), "enviar correo") > 0 And C.Offset(, 2) = "" Then
Q = 1 + Q
ReDim Preserve LD(1 To Q)
LD(Q) = C.Offset(, 1)
C.Offset(, 2) = ChrW(9086)
End If
Next
If Q = 0 Then MsgBox "Sin correos que enviar.": End
With CreateObject("Outlook.Application")
With .CreateItem(0)
.BCC = Join(LD, ";")
.Subject = Range("h4").Value
.Body = Range("h5").Value
.Display
End With
End With
End
End Sub
Por ejemplo si puedo identificar en la instrucción .Body = Range("h5").Value la celda a la que se hace referencia es la h5, y que luego puedo cambiarla por A1 o z500 si lo deseo, pero en el resto no logro distingirlo
¿
¿Podrían indicarme cuales son los valores que puedo variar para adptarlo a otra hoja?
1 Respuesta
H o l a:
Por lo que veo toda la información está en una tabla.
Suponiendo que la tabla empieza en la columna A, te anexo la macro actualizada para que funcione pero con referencias a los nombres de las columnas:
Sub Macro68()
'------------------
'by Cacho Rodríguez
'------------------
Dim LD(), C As Range, Q%
For Each C In ActiveSheet.ListObjects(1).DataBodyRange.Columns("B").Cells
If InStr(LCase(C), "enviar correo") > 0 And Cells(C.Row, "D") = "" Then
Q = 1 + Q
ReDim Preserve LD(1 To Q)
LD(Q) = Cells(C.Row, "C")
Cells(C.Row, "D") = ChrW(9086)
End If
Next
'
If Q = 0 Then MsgBox "Sin correos que enviar.": End
With CreateObject("Outlook.Application")
With .CreateItem(0)
.BCC = Join(LD, ";")
.Subject = Range("h4").Value
.Body = Range("h5").Value
.Display
End With
End With
End
End SubEntonces realiza los siguientes cambios:
- En esta línea, cambia la "B" por la columna donde tienes la frase "enviar correo"
For Each C In ActiveSheet.ListObjects(1).DataBodyRange.Columns("B").Cells- En esta línea, cambia la "D", por la columna donde se revisa si está vacía la celda
If InStr(LCase(C), "enviar correo") > 0 And Cells(C.Row, "D") = "" Then
- En esta línea, cambia la "C", por la columna donde tienes los correos
LD(Q) = Cells(C.Row, "C")
- Y por último cambia en esta línea la "D", por la columna donde se revisa si está vacía la celda
Cells(C.Row, "D") = ChrW(9086)
Si la tabla no empieza en la columna A, entonces tienes que decirme en dónde empieza y en dónde vas a poner los nuevos datos.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
