first of all I have already gotten a lot of help from Tom Ogilvy, which I
really appreciate, but here is what he has helped me get so far:

Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = ActiveSheet.PivotTables(1).TableRange2
Set rng = Range(rng(1).Offset(-7, 0), rng)
Workbooks.Add Template:=xlWBATWorksheet
ActiveSheet.Range("A1").Select
rng.Copy
ActiveSheet.Range("A1").PasteSpecial xlValues
ActiveSheet.Range("A1").PasteSpecial xlFormats
ActiveWorkbook.SendMail Subject:="Scheduling", "
ActiveWorkbook.Close SaveChanges:=False

End Sub

What I am still trying to figure out is how I can first of all send the
sheet to an unsent email where the user could then choose a subject and pick
the users they would like to send it to, right now it just sends to
. Also I need to figure out how to ensure the copied and pasted
information has the same format, because when it emails some columns are
shrunk which makes the information difficult to read. Thank you for any help
you may have, I really appreciate it!

Only possible when You use this
http://www.rondebruin.nl/mail/tips1.htm

.SendMail "", "This is the Subject line"


You have more control when you use the outlook code
http://www.rondebruin.nl/sendmail.htm



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Josh Johansen" wrote in message ...
first of all I have already gotten a lot of help from Tom Ogilvy, which I
really appreciate, but here is what he has helped me get so far:

Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = ActiveSheet.PivotTables(1).TableRange2
Set rng = Range(rng(1).Offset(-7, 0), rng)
Workbooks.Add Template:=xlWBATWorksheet
ActiveSheet.Range("A1").Select
rng.Copy
ActiveSheet.Range("A1").PasteSpecial xlValues
ActiveSheet.Range("A1").PasteSpecial xlFormats
ActiveWorkbook.SendMail Subject:="Scheduling", "
ActiveWorkbook.Close SaveChanges:=False

End Sub

What I am still trying to figure out is how I can first of all send the
sheet to an unsent email where the user could then choose a subject and pick
the users they would like to send it to, right now it just sends to
. Also I need to figure out how to ensure the copied and pasted
information has the same format, because when it emails some columns are
shrunk which makes the information difficult to read. Thank you for any help
you may have, I really appreciate it!

If I copy the link on this page:

http://www.rondebruin.nl/mail/folder2/mail4.htm

will I have to make a range that will always cover the size of the pivot
table or is there a way to set the range so it will change depending on the
size of the pivot table?

"Ron de Bruin" wrote:

Only possible when You use this
http://www.rondebruin.nl/mail/tips1.htm

.SendMail "", "This is the Subject line"


You have more control when you use the outlook code
http://www.rondebruin.nl/sendmail.htm



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Josh Johansen" wrote in message ...
first of all I have already gotten a lot of help from Tom Ogilvy, which I
really appreciate, but here is what he has helped me get so far:

Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = ActiveSheet.PivotTables(1).TableRange2
Set rng = Range(rng(1).Offset(-7, 0), rng)
Workbooks.Add Template:=xlWBATWorksheet
ActiveSheet.Range("A1").Select
rng.Copy
ActiveSheet.Range("A1").PasteSpecial xlValues
ActiveSheet.Range("A1").PasteSpecial xlFormats
ActiveWorkbook.SendMail Subject:="Scheduling", "
ActiveWorkbook.Close SaveChanges:=False

End Sub

What I am still trying to figure out is how I can first of all send the
sheet to an unsent email where the user could then choose a subject and pick
the users they would like to send it to, right now it just sends to
. Also I need to figure out how to ensure the copied and pasted
information has the same format, because when it emails some columns are
shrunk which makes the information difficult to read. Thank you for any help
you may have, I really appreciate it!

See Tom's example to set the range

ActiveSheet.PivotTables(1).TableRange2




--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Josh Johansen" wrote in message ...
If I copy the link on this page:

http://www.rondebruin.nl/mail/folder2/mail4.htm

will I have to make a range that will always cover the size of the pivot
table or is there a way to set the range so it will change depending on the
size of the pivot table?

"Ron de Bruin" wrote:

Only possible when You use this
http://www.rondebruin.nl/mail/tips1.htm

.SendMail "", "This is the Subject line"


You have more control when you use the outlook code
http://www.rondebruin.nl/sendmail.htm



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Josh Johansen" wrote in message
...
first of all I have already gotten a lot of help from Tom Ogilvy, which I
really appreciate, but here is what he has helped me get so far:

Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = ActiveSheet.PivotTables(1).TableRange2
Set rng = Range(rng(1).Offset(-7, 0), rng)
Workbooks.Add Template:=xlWBATWorksheet
ActiveSheet.Range("A1").Select
rng.Copy
ActiveSheet.Range("A1").PasteSpecial xlValues
ActiveSheet.Range("A1").PasteSpecial xlFormats
ActiveWorkbook.SendMail Subject:="Scheduling", "
ActiveWorkbook.Close SaveChanges:=False

End Sub

What I am still trying to figure out is how I can first of all send the
sheet to an unsent email where the user could then choose a subject and pick
the users they would like to send it to, right now it just sends to
. Also I need to figure out how to ensure the copied and pasted
information has the same format, because when it emails some columns are
shrunk which makes the information difficult to read. Thank you for any help
you may have, I really appreciate it!

Here is the code I put in... When I exit control mode and attempt to use the
button nothing happens. I am sure I copied something wrong, I am just not
familiar at all with VBA. Thanks again!

Sub Mail_Range()
'Working in 2000-2007
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:j200").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
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsx": FileFormatNum = 51
End If

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
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

"Ron de Bruin" wrote:

Only possible when You use this
http://www.rondebruin.nl/mail/tips1.htm

.SendMail "", "This is the Subject line"


You have more control when you use the outlook code
http://www.rondebruin.nl/sendmail.htm



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Josh Johansen" wrote in message ...
first of all I have already gotten a lot of help from Tom Ogilvy, which I
really appreciate, but here is what he has helped me get so far:

Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = ActiveSheet.PivotTables(1).TableRange2
Set rng = Range(rng(1).Offset(-7, 0), rng)
Workbooks.Add Template:=xlWBATWorksheet
ActiveSheet.Range("A1").Select
rng.Copy
ActiveSheet.Range("A1").PasteSpecial xlValues
ActiveSheet.Range("A1").PasteSpecial xlFormats
ActiveWorkbook.SendMail Subject:="Scheduling", "
ActiveWorkbook.Close SaveChanges:=False

End Sub

What I am still trying to figure out is how I can first of all send the
sheet to an unsent email where the user could then choose a subject and pick
the users they would like to send it to, right now it just sends to
. Also I need to figure out how to ensure the copied and pasted
information has the same format, because when it emails some columns are
shrunk which makes the information difficult to read. Thank you for any help
you may have, I really appreciate it!

What is the code in the button click

Private Sub CommandButton1_Click()

End Sub

Must be

Private Sub CommandButton1_Click()
Call Mail_Range
End Sub



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Josh Johansen" wrote in message ...
Here is the code I put in... When I exit control mode and attempt to use the
button nothing happens. I am sure I copied something wrong, I am just not
familiar at all with VBA. Thanks again!

Sub Mail_Range()
'Working in 2000-2007
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:j200").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
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsx": FileFormatNum = 51
End If

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
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

"Ron de Bruin" wrote:

Only possible when You use this
http://www.rondebruin.nl/mail/tips1.htm

.SendMail "", "This is the Subject line"


You have more control when you use the outlook code
http://www.rondebruin.nl/sendmail.htm



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Josh Johansen" wrote in message
...
first of all I have already gotten a lot of help from Tom Ogilvy, which I
really appreciate, but here is what he has helped me get so far:

Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = ActiveSheet.PivotTables(1).TableRange2
Set rng = Range(rng(1).Offset(-7, 0), rng)
Workbooks.Add Template:=xlWBATWorksheet
ActiveSheet.Range("A1").Select
rng.Copy
ActiveSheet.Range("A1").PasteSpecial xlValues
ActiveSheet.Range("A1").PasteSpecial xlFormats
ActiveWorkbook.SendMail Subject:="Scheduling", "
ActiveWorkbook.Close SaveChanges:=False

End Sub

What I am still trying to figure out is how I can first of all send the
sheet to an unsent email where the user could then choose a subject and pick
the users they would like to send it to, right now it just sends to
. Also I need to figure out how to ensure the copied and pasted
information has the same format, because when it emails some columns are
shrunk which makes the information difficult to read. Thank you for any help
you may have, I really appreciate it!

I really appreciate all of your help, I have gone through your help lists and
downloaded your practice sheet and it worked great, but I am very confused
somewhere. Here is everything I have on the sheet code: The first and third
sections are for a calander, I am sorry it is so long, I really just dont
know what I am doing wrong.

Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "mm/dd/yyy"
ActiveCell.Select
Calendar1.Visible = False
End Sub

Private Sub CommandButton1_Click()
Call Mail_Range
End Sub

Private Sub Worksheet_Selectionchange(ByVal Target As Range)
If Target.Cells.Count 1 Then Exit Sub
If Not Application.Intersect(Range("F3"), Target) Is Nothing Then
Calendar1.Left = Range("E1").Left
Calendar1.Top = Range("E1").Top
Calendar1.Visible = True
' select Today's date in the Calendar
Calendar1.Value = Date
ElseIf Calendar1.Visible Then Calendar1.Visible = False
End If
End Sub
Sub Mail_ActiveSheet()
'Working in 2000-2007
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security dialog
that you only
'see when you copy a sheet from a xlsm file with macro's
disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With

' 'Change all cells in the worksheet to values if you want
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy
h-mm-ss")

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub



"Ron de Bruin" wrote:

What is the code in the button click

Private Sub CommandButton1_Click()

End Sub

Must be

Private Sub CommandButton1_Click()
Call Mail_Range
End Sub



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Josh Johansen" wrote in message ...
Here is the code I put in... When I exit control mode and attempt to use the
button nothing happens. I am sure I copied something wrong, I am just not
familiar at all with VBA. Thanks again!

Sub Mail_Range()
'Working in 2000-2007
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:j200").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
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsx": FileFormatNum = 51
End If

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
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

"Ron de Bruin" wrote:

Only possible when You use this
http://www.rondebruin.nl/mail/tips1.htm

.SendMail "", "This is the Subject line"


You have more control when you use the outlook code
http://www.rondebruin.nl/sendmail.htm



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Josh Johansen" wrote in message
...
first of all I have already gotten a lot of help from Tom Ogilvy, which I
really appreciate, but here is what he has helped me get so far:

Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = ActiveSheet.PivotTables(1).TableRange2
Set rng = Range(rng(1).Offset(-7, 0), rng)
Workbooks.Add Template:=xlWBATWorksheet
ActiveSheet.Range("A1").Select
rng.Copy
ActiveSheet.Range("A1").PasteSpecial xlValues
ActiveSheet.Range("A1").PasteSpecial xlFormats
ActiveWorkbook.SendMail Subject:="Scheduling", "
ActiveWorkbook.Close SaveChanges:=False

End Sub

What I am still trying to figure out is how I can first of all send the
sheet to an unsent email where the user could then choose a subject and pick
the users they would like to send it to, right now it just sends to
. Also I need to figure out how to ensure the copied and pasted
information has the same format, because when it emails some columns are
shrunk which makes the information difficult to read. Thank you for any help
you may have, I really appreciate it!

Hi Josh

The event code and the button code must be in the sheet module but the macro belong in a normal module

Alt F11
Insert module
Cut/paste the sub there

--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Josh Johansen" wrote in message ...
I really appreciate all of your help, I have gone through your help lists and
downloaded your practice sheet and it worked great, but I am very confused
somewhere. Here is everything I have on the sheet code: The first and third
sections are for a calander, I am sorry it is so long, I really just dont
know what I am doing wrong.

Private Sub Calendar1_Click()
ActiveCell.Value = CDbl(Calendar1.Value)
ActiveCell.NumberFormat = "mm/dd/yyy"
ActiveCell.Select
Calendar1.Visible = False
End Sub

Private Sub CommandButton1_Click()
Call Mail_Range
End Sub

Private Sub Worksheet_Selectionchange(ByVal Target As Range)
If Target.Cells.Count 1 Then Exit Sub
If Not Application.Intersect(Range("F3"), Target) Is Nothing Then
Calendar1.Left = Range("E1").Left
Calendar1.Top = Range("E1").Top
Calendar1.Visible = True
' select Today's date in the Calendar
Calendar1.Value = Date
ElseIf Calendar1.Visible Then Calendar1.Visible = False
End If
End Sub
Sub Mail_ActiveSheet()
'Working in 2000-2007
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Set Sourcewb = ActiveWorkbook

'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security dialog
that you only
'see when you copy a sheet from a xlsm file with macro's
disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With

' 'Change all cells in the worksheet to values if you want
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " & Format(Now, "dd-mmm-yy
h-mm-ss")

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
End With
On Error GoTo 0
.Close SaveChanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub



"Ron de Bruin" wrote:

What is the code in the button click

Private Sub CommandButton1_Click()

End Sub

Must be

Private Sub CommandButton1_Click()
Call Mail_Range
End Sub



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Josh Johansen" wrote in message
...
Here is the code I put in... When I exit control mode and attempt to use the
button nothing happens. I am sure I copied something wrong, I am just not
familiar at all with VBA. Thanks again!

Sub Mail_Range()
'Working in 2000-2007
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:j200").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
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
FileExtStr = ".xlsx": FileFormatNum = 51
End If

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Dest.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Send 'or use .Display
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

"Ron de Bruin" wrote:

Only possible when You use this
http://www.rondebruin.nl/mail/tips1.htm

.SendMail "", "This is the Subject line"


You have more control when you use the outlook code
http://www.rondebruin.nl/sendmail.htm



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm


"Josh Johansen" wrote in message
...
first of all I have already gotten a lot of help from Tom Ogilvy, which I
really appreciate, but here is what he has helped me get so far:

Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = ActiveSheet.PivotTables(1).TableRange2
Set rng = Range(rng(1).Offset(-7, 0), rng)
Workbooks.Add Template:=xlWBATWorksheet
ActiveSheet.Range("A1").Select
rng.Copy
ActiveSheet.Range("A1").PasteSpecial xlValues
ActiveSheet.Range("A1").PasteSpecial xlFormats
ActiveWorkbook.SendMail Subject:="Scheduling", "
ActiveWorkbook.Close SaveChanges:=False

End Sub

What I am still trying to figure out is how I can first of all send the
sheet to an unsent email where the user could then choose a subject and pick
the users they would like to send it to, right now it just sends to
. Also I need to figure out how to ensure the copied and pasted
information has the same format, because when it emails some columns are
shrunk which makes the information difficult to read. Thank you for any help
you may have, I really appreciate it!

by changing the code on the sheet to:

Private Sub CommandButton1_Click()
Call Mail_ActiveSheet
End Sub

I was able to make it work. It doesnt give me a chance to choose
recipients, and it is still a pretty large file, It would almost be better if
it were just a text file. did you get my email?

"Josh Johansen" wrote:

first of all I have already gotten a lot of help from Tom Ogilvy, which I
really appreciate, but here is what he has helped me get so far:

Private Sub CommandButton1_Click()
Dim rng As Range
Set rng = ActiveSheet.PivotTables(1).TableRange2
Set rng = Range(rng(1).Offset(-7, 0), rng)
Workbooks.Add Template:=xlWBATWorksheet
ActiveSheet.Range("A1").Select
rng.Copy
ActiveSheet.Range("A1").PasteSpecial xlValues
ActiveSheet.Range("A1").PasteSpecial xlFormats
ActiveWorkbook.SendMail Subject:="Scheduling", "
ActiveWorkbook.Close SaveChanges:=False

End Sub

What I am still trying to figure out is how I can first of all send the
sheet to an unsent email where the user could then choose a subject and pick
the users they would like to send it to, right now it just sends to
. Also I need to figure out how to ensure the copied and pasted
information has the same format, because when it emails some columns are
shrunk which makes the information difficult to read. Thank you for any help
you may have, I really appreciate it!