purpleozzie
Board Regular
- Joined
- Jun 8, 2015
- Messages
- 64
Hi guys,
I use the follwing VBA to save and send to an email address in cell D6 once a button is pressed.. I have no knowledge of VBA and nicked this off the internet. I wanted to change it so that firstly the body of the email is the contents of cell B13 and if there is any text in cell D5 it CC's in a colleague. The colleague's email address is not based on a cell value and will always be the same email address.. If there is no text in D5 it doesn't CC in anyone..
Sub approve()
Dim wb1 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object
Recip = [D6].Value
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb1 = ActiveWorkbook
'Make a copy of the file/Open it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.Recipients.Add Recip
.CC = "bb@bb.com"
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add TempFilePath & TempFileName & FileExtStr
.Send 'or use .Display
End With
On Error GoTo 0
'Delete the file
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
cheers,
I use the follwing VBA to save and send to an email address in cell D6 once a button is pressed.. I have no knowledge of VBA and nicked this off the internet. I wanted to change it so that firstly the body of the email is the contents of cell B13 and if there is any text in cell D5 it CC's in a colleague. The colleague's email address is not based on a cell value and will always be the same email address.. If there is no text in D5 it doesn't CC in anyone..
Sub approve()
Dim wb1 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object
Recip = [D6].Value
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb1 = ActiveWorkbook
'Make a copy of the file/Open it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.Recipients.Add Recip
.CC = "bb@bb.com"
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add TempFilePath & TempFileName & FileExtStr
.Send 'or use .Display
End With
On Error GoTo 0
'Delete the file
Kill TempFilePath & TempFileName & FileExtStr
Set OutMail = Nothing
Set OutApp = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
cheers,