G
Guest
By using the adapted code below, I have managed to get the range selected,
copied to another file and sent.
However I cannot get a way to insert text before it is sent.
I wouldif possible like 2 options:
1. to put pre-prepared text into another cell or range
2. type it in as body text, and then hit the Send button.
Many thanks
'Email Comparison
'*****************************
Sub Email_Selected_Range()
Dim Recipients
Dim Subject
Dim Message
Subject = Range("H1")
Recipient = Range("O1")
Application.ScreenUpdating = True
ActiveSheet.Unprotect
'hides selected columns
Columns("B:B").Select
Selection.EntireColumn.Hidden = True
Columns("G:G").Select
Selection.EntireColumn.Hidden = True
Columns("I:I").Select
Selection.EntireColumn.Hidden = True
Columns("Z:AA").Select
Selection.EntireColumn.Hidden = True
Range("A8:AA37").Select
Selection.Sort Key1:=ActiveCell.Offset(0, 24).Range("A1"), Order1:= _
xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom
' the range which is to be selected for email
Range("A1:Y37").Select
'***********************************************************************
'***********************************************************************
Dim source As Range
Dim dest As Workbook
Dim strdate As String
Set source = Nothing
On Error Resume Next
Set source = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If source Is Nothing Then
MsgBox "The source is not a range or the sheet is protect, please
correct and try again.", vbOKOnly
Exit Sub
End If
If ActiveWindow.SelectedSheets.Count > 1 Or _
Selection.Cells.Count = 1 Or _
Selection.Areas.Count > 1 Then
MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
"You have more than one sheet selected." & vbNewLine & _
"You only selected one cell." & vbNewLine & _
"You selected more than one area." & vbNewLine & vbNewLine & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If
Application.ScreenUpdating = False
Set dest = Workbooks.Add(xlWBATWorksheet)
source.Copy
With dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
' Paste:=8 will copy the column width in Excel 2000 and higher
' If you use Excel 97 use the other example
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
End With
strdate = Format(Now, "dd-mm-yy h-mm-ss")
With dest
.SaveAs "Client copy of " & ThisWorkbook.Name _
& " " & strdate & ".xls"
.SendMail Recipients:=Recipient, Subject:=Subject
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
'************************************************************************
'returns worksheet to previous state
Columns("G:I").EntireColumn.Select
Selection.EntireColumn.Hidden = False
Columns("Z:AA").EntireColumn.Select
Selection.EntireColumn.Hidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios _
:=True
Range("D4").Select
copied to another file and sent.
However I cannot get a way to insert text before it is sent.
I wouldif possible like 2 options:
1. to put pre-prepared text into another cell or range
2. type it in as body text, and then hit the Send button.
Many thanks
'Email Comparison
'*****************************
Sub Email_Selected_Range()
Dim Recipients
Dim Subject
Dim Message
Subject = Range("H1")
Recipient = Range("O1")
Application.ScreenUpdating = True
ActiveSheet.Unprotect
'hides selected columns
Columns("B:B").Select
Selection.EntireColumn.Hidden = True
Columns("G:G").Select
Selection.EntireColumn.Hidden = True
Columns("I:I").Select
Selection.EntireColumn.Hidden = True
Columns("Z:AA").Select
Selection.EntireColumn.Hidden = True
Range("A8:AA37").Select
Selection.Sort Key1:=ActiveCell.Offset(0, 24).Range("A1"), Order1:= _
xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom
' the range which is to be selected for email
Range("A1:Y37").Select
'***********************************************************************
'***********************************************************************
Dim source As Range
Dim dest As Workbook
Dim strdate As String
Set source = Nothing
On Error Resume Next
Set source = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If source Is Nothing Then
MsgBox "The source is not a range or the sheet is protect, please
correct and try again.", vbOKOnly
Exit Sub
End If
If ActiveWindow.SelectedSheets.Count > 1 Or _
Selection.Cells.Count = 1 Or _
Selection.Areas.Count > 1 Then
MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _
"You have more than one sheet selected." & vbNewLine & _
"You only selected one cell." & vbNewLine & _
"You selected more than one area." & vbNewLine & vbNewLine & _
"Please correct and try again.", vbOKOnly
Exit Sub
End If
Application.ScreenUpdating = False
Set dest = Workbooks.Add(xlWBATWorksheet)
source.Copy
With dest.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
' Paste:=8 will copy the column width in Excel 2000 and higher
' If you use Excel 97 use the other example
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
End With
strdate = Format(Now, "dd-mm-yy h-mm-ss")
With dest
.SaveAs "Client copy of " & ThisWorkbook.Name _
& " " & strdate & ".xls"
.SendMail Recipients:=Recipient, Subject:=Subject
.ChangeFileAccess xlReadOnly
Kill .FullName
.Close False
End With
'************************************************************************
'returns worksheet to previous state
Columns("G:I").EntireColumn.Select
Selection.EntireColumn.Hidden = False
Columns("Z:AA").EntireColumn.Select
Selection.EntireColumn.Hidden = False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios _
:=True
Range("D4").Select