Hey gang,
I am using vba to send my worksheet to outlook as an attachment, it works well. Recently I was asked to have a section of the worksheet in the email body. I tried Mr. Bruins code it it works for putting the portion of the sheet in the body of the email and the attachemnt. I need to combine the two scripts to do both, send as attachemnt, and the portion in the body of the email.I have listed both sets of code and hope that someone could give me a hand putting them together.
Thanks,
Pujo
Attachment Code:
Selection in body code:
I am using vba to send my worksheet to outlook as an attachment, it works well. Recently I was asked to have a section of the worksheet in the email body. I tried Mr. Bruins code it it works for putting the portion of the sheet in the body of the email and the attachemnt. I need to combine the two scripts to do both, send as attachemnt, and the portion in the body of the email.I have listed both sets of code and hope that someone could give me a hand putting them together.
Thanks,
Pujo
Attachment Code:
Code:
Private Sub CommandButton2_Click()
Dim OL As Object
Dim EmailItem As Object
Dim Wb As Workbook
ActiveSheet.Unprotect Password:="xxx"
Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Set Wb = ActiveWorkbook
Wb.Save
SigString = "C:\Documents and Settings\" & Environ("username") & _
"\Application Data\Microsoft\Signatures\*.htm"
Dim Try As String
Try = Dir(SigString)
If Try <> "" Then
SigString = "C:\Documents and Settings\" & Environ("username") & _
"\Application Data\Microsoft\Signatures\" & Try
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
With EmailItem
.Subject = "Daily Crew Activity" & " " & Format(Now, "mmm-dd-yy")
strbody = "Good Morning, Please See Attached File."
.To = "[EMAIL="me@me.com"]me@me.com[/EMAIL]"
.Attachments.Add Wb.FullName
.HTMLBody = strbody & "" & Signature
.Display
'.Send
End With
Application.ScreenUpdating = True
Set Wb = Nothing
Set OL = Nothing
Set EmailItem = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, Password:="xxx"
End With
End Sub
Selection in body code:
Code:
Sub Mail_Range_Outlook_Body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2010
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set rng = Nothing
On Error Resume Next
Set rng = Sheets("MailRangeSelection").Range("B19:B24").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
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "[EMAIL="ron@debruin.nl"]ron@debruin.nl[/EMAIL]"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = RangetoHTML(rng)
.Display 'or use .Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub