I am trying to copy the range in excel to the body of an email.
I have looked at different posts and the coding is very different from the coding that I am using for creating my email.
After the email is created I cn do a "CTRL V" and it will show up in my email. However I want to code instead.
Sub Macro1()
'
Dim Subj As String
Dim msg As String
Dim ppbegindate As Date
Dim ppenddate As Date
Dim EndRow As Long
Dim URL As String
Dim data As String
Sheets("Payout").Select
Columns("A:K").Select
ActiveWorkbook.Worksheets("Payout").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Payout").Sort.SortFields.Add Key:=Range("K2:K63") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Payout").Sort
.SetRange Range("A1:K63")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ppbegindate = Sheets("Enter").Cells(5, 5)
ppenddate = Sheets("Enter").Cells(6, 5)
Sheets("Payout").Select
EndRow = Sheets("Payout").Range("A" & Rows.Count).End(xlUp).Row
Range("A1:K" & EndRow).Select
data = Selection.Copy
Subj = "Home Depot Stack Ranking " & ppbegindate & " to " & ppenddate
msg = "Hello," & vbCrLf & vbCrLf
msg = msg & "Below is Stack Ranking for the following dates " & ppbegindate & " to " & ppenddate & "." & vbCrLf & vbCrLf
msg = msg & "Please let me know if Approved." & vbCrLf & vbCrLf
msg = msg & data
'Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
msg = Application.WorksheetFunction.Substitute(msg, " ", "%20")
'Replace carriage returns with %0D%0A (hex)
msg = Application.WorksheetFunction.Substitute(msg, vbCrLf, "%0D%0A")
'Create the URL
URL = "mailto:" & "" & "?subject=" & Subj & "&body=" & msg
'Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
End Sub
*******************************************************************************
This is what I get when I run the macro
Subjsect = Home Depot Stack Ranking 7/20/2013 to 8/2/2013
Body =
Hello, <o></o>
Below is Stack Ranking for the following dates 7/20/2013 to 8/2/2013. <o></o>
Please let me know if Approved. <o></o>
True
The True is where the select range should be pasted.
I have looked at different posts and the coding is very different from the coding that I am using for creating my email.
After the email is created I cn do a "CTRL V" and it will show up in my email. However I want to code instead.
Sub Macro1()
'
Dim Subj As String
Dim msg As String
Dim ppbegindate As Date
Dim ppenddate As Date
Dim EndRow As Long
Dim URL As String
Dim data As String
Sheets("Payout").Select
Columns("A:K").Select
ActiveWorkbook.Worksheets("Payout").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Payout").Sort.SortFields.Add Key:=Range("K2:K63") _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Payout").Sort
.SetRange Range("A1:K63")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ppbegindate = Sheets("Enter").Cells(5, 5)
ppenddate = Sheets("Enter").Cells(6, 5)
Sheets("Payout").Select
EndRow = Sheets("Payout").Range("A" & Rows.Count).End(xlUp).Row
Range("A1:K" & EndRow).Select
data = Selection.Copy
Subj = "Home Depot Stack Ranking " & ppbegindate & " to " & ppenddate
msg = "Hello," & vbCrLf & vbCrLf
msg = msg & "Below is Stack Ranking for the following dates " & ppbegindate & " to " & ppenddate & "." & vbCrLf & vbCrLf
msg = msg & "Please let me know if Approved." & vbCrLf & vbCrLf
msg = msg & data
'Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
msg = Application.WorksheetFunction.Substitute(msg, " ", "%20")
'Replace carriage returns with %0D%0A (hex)
msg = Application.WorksheetFunction.Substitute(msg, vbCrLf, "%0D%0A")
'Create the URL
URL = "mailto:" & "" & "?subject=" & Subj & "&body=" & msg
'Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
End Sub
*******************************************************************************
This is what I get when I run the macro
Subjsect = Home Depot Stack Ranking 7/20/2013 to 8/2/2013
Body =
Hello, <o></o>
Below is Stack Ranking for the following dates 7/20/2013 to 8/2/2013. <o></o>
Please let me know if Approved. <o></o>
True
The True is where the select range should be pasted.