View Single Post
  #5   Report Post  
Posted to microsoft.public.excel.programming
Josh Johansen Josh Johansen is offline
external usenet poster
 
Posts: 72
Default Programing a button to copy and email

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!