add additional code to code
Hi
This should do it:
Sub Mail_Selection_Range_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2007
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim TestRange As Range
Set TestRange = Range("B16, B19:B20")
For Each Cell In TestRange
If Cell.Value = "" Then
MsgStr = MsgStr & Cell.Address & " "
End If
Next
If MsgStr < "" Then
Msg = MsgBox("You must fill in cell(s) " & MsgStr, vbInformation, _
"Regards, Per Jessen")
Exit Sub
End If
Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng = Selection.SpecialCells(xlCellTypeVisible)
'You can also use a range if you want
'Set rng =
Sheets("YourSheet").Range("D4:D12").SpecialCells (xlCellTypeVisible)
On Error GoTo 0
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
SubjStr = "Contract " & Range("B12").Value & Range("A7").Value
On Error Resume Next
With OutMail
.To = "l"
.CC = ""
.BCC = ""
.Subject = SubjStr
.HTMLBody = RangetoHTML(rng)
.Send 'or use .Display
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Regards,
Per
"Marilyn" skrev i meddelelsen
...
Hello Below is Ron De Bruins send code. How and where do I add the
following to the code
if range(" B16, B19,B20") if is empty(cell.Value) then
MsbgBox "You must fill in cell" & cell.address
also in the subject line I want
.Subject = " Contract " then the value in cell B12 and A7
thanks in Advance
cc
|