Hi,
I would like to start by thanking everyone who posts answers on this forum. I have been using it for years to get answers and have been able to develop a very good understanding of excel in my career thanks to the generosity of others. I will be looking for any unanswered questions and trying to give back as I have received so much.
I knew the day would come when I needed to post a question as I could no longer find the answers I needed and today I have reached that day.
I have managed to peice toghether the below code in Excel 2010 to email part of a worksheet using a command button and it works great. I would just like to tweak it so I can use some cell values for things like email text, to, cc. Also, I would like to make the file name a cell value. This file does not need to be saved, just used in the attachment.
I would like to use the below cell values instead of what is currently being used:
Cell M1 - Subject instead of: .Subject = "xxxxxxxxxx"
Cell M2 - to - instead of: .to = "xxxxxxxxx@xxxxxxx.com"
Cell M3 - cc - instead of: .CC = ""
Cell M4 - Message Body - instead of: .Body = "xxxxxxxxxxxxx"
Cell M5 - File name - instead of: TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
Here is the current code in full:
=========================
Sub Mail_Range()
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:H50").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = "xxxxxxxxx@xxxxxxx.com"
.CC = ""
.BCC = ""
.Subject = "xxxxxxxxxx"
.Body = "xxxxxxxxxxxxx"
.Attachments.Add Dest.FullName
.Send
End With
On Error GoTo 0
.Close savechanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
=================
Thanks again,
Ben
I would like to start by thanking everyone who posts answers on this forum. I have been using it for years to get answers and have been able to develop a very good understanding of excel in my career thanks to the generosity of others. I will be looking for any unanswered questions and trying to give back as I have received so much.
I knew the day would come when I needed to post a question as I could no longer find the answers I needed and today I have reached that day.
I have managed to peice toghether the below code in Excel 2010 to email part of a worksheet using a command button and it works great. I would just like to tweak it so I can use some cell values for things like email text, to, cc. Also, I would like to make the file name a cell value. This file does not need to be saved, just used in the attachment.
I would like to use the below cell values instead of what is currently being used:
Cell M1 - Subject instead of: .Subject = "xxxxxxxxxx"
Cell M2 - to - instead of: .to = "xxxxxxxxx@xxxxxxx.com"
Cell M3 - cc - instead of: .CC = ""
Cell M4 - Message Body - instead of: .Body = "xxxxxxxxxxxxx"
Cell M5 - File name - instead of: TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
Here is the current code in full:
=========================
Sub Mail_Range()
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Set Source = Nothing
On Error Resume Next
Set Source = Range("A1:H50").SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If Source Is Nothing Then
MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ActiveWorkbook
Set Dest = Workbooks.Add(xlWBATWorksheet)
Source.Copy
With Dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial Paste:=xlPasteValues
.Cells(1).PasteSpecial Paste:=xlPasteFormats
.Cells(1).Select
Application.CutCopyMode = False
End With
TempFilePath = Environ$("temp") & "\"
TempFileName = "Selection of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = "xxxxxxxxx@xxxxxxx.com"
.CC = ""
.BCC = ""
.Subject = "xxxxxxxxxx"
.Body = "xxxxxxxxxxxxx"
.Attachments.Add Dest.FullName
.Send
End With
On Error GoTo 0
.Close savechanges:=False
End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
=================
Thanks again,
Ben