Macro para mandar mail desde excel conrango de celdas
Tengo esta macro,
La puedes modificar para que tome un rango en lugar de una celda (N12).
Sub FREIGHTMAIL()
Row = ActiveCell.Row
Customer = Row
Custname = Range("O" & Customer & "")
Cmail = Range("N" & Customer & "")
CCmail = Range("N8")
Fromm = Range("N10")
' USAport = Range("AH" & Customer & "")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
Arrcustomer = Range("CC" & Customer & "")
Destin = Range("K" & Customer & "")
Destinstate = Range("L" & Customer & "")
Order = Range("N12")
Msg = MsgBox("Do you want to send email requesting freight?", vbYesNo, "Customer Arrival Notice")
If Msg <> 6 Then
Exit Sub
End If
On Error Resume Next
With OutMail
' 1 not emptys
If Worksheets("Containers").Range("N12") <> "" Then
.To = " " & Cmail & " "
.CC = " " & CCmail & " "
.Subject = "Ffreight rate needed"
.Body = Custname & "," & vbNewLine & vbNewLine & "Can you please get a freight rate for:" & vbNewLine & vbNewLine & Fromm & vbNewLine & Order _
& vbNewLine & vbNewLine & "Regards," & vbNewLine & "George Cue Perez" & vbNewLine & "Logistics Manager" & vbNewLine & "Strategic Tire Supply Group" & _
vbNewLine & "10201 Wayzata Blvd. Suite #250" & _
vbNewLine & "Minnetonka, MN 55305" & vbNewLine & "Tel: 763-746-0410" & vbNewLine & "Cell: 952 242 6992"
.Send
Else
Exit Sub
End If
End With
'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Range("P" & Customer & "").Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight2
.TintAndShade = 0.799981688894314
.PatternTintAndShade = 0
End With
End Sub