VBA Send and Save

[Sovereignty9]

Can anyone help me??

Please look at the code below vba coding I have used on a work spreadsheet. First lot of coding Is the main coding I want rectified however I'm struggling with the automated save bit, and I do not want it too be a temporary copy that is deleted. I want the code to ensure that when the assigned button is clicked to automatically save it to a certain location as "Rosti Sills Delivery Check DDMMYYY". You can see from the code below send and save that I have got this to happen on a stand alone save button but unable to make it work when send an email at the same time.

Can anyone please help and suggest some changes to get this working as required.

Much appreciated

JoeJoe



Sub EmailandSaveCellValue()

'Variable declaration
Dim oApp As Object, _
oMail As Object, _
WB As Workbook, _
FileName As String, MailSub As String, MailTxt As String

'************************************************* ********
'Set email details; Comment out if not required
Const MailTo = "ben.kirby2@plasticomnium.com; ben.kirby@plasticomnium.com; dominic.hardy@plasticomnium.com; andy.wilson@plasticomnium.com; damian.lee@plasticomnium.com; mevans@plasticomnium.com; gbowley@plasticomnium.com"
Const MailCC = ""
Const MailBCC = ""
MailSub = "Rosti Sills Tracking "
MailTxt = "Hi All," & vbCrLf & vbNewLine & "Please find attached the Rosti sills tracking and handover." & vbCrLf & vbNewLine & "Regards" & vbCrLf & vbNewLine & "GoodsIn" & Chr(10) & Chr(10) & Chr(10)
'************************************************* ********

'Turns off screen updating
Application.ScreenUpdating = False

'Makes a copy of the active sheet and save it to
'a temporary file
ActiveWorkbook.Save
Set WB = ActiveWorkbook
FileName = ("FileName")
On Error Resume Next
Kill "C:" & FileName
On Error GoTo 0
WB.SaveAs FileName:="D:\Personal\measham.goodsin\Desktop\Rosti Delivery Checks\Sent" & FileName

'Creates and shows the outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = MailTo
.Cc = MailCC
.Bcc = MailBCC
.Subject = MailSub
.Body = MailTxt
.Attachments.Add WB.FullName
.Display
End With

'Deletes the temporary file
WB.ChangeFileAccess Mode:=xlReadOnly
Kill WB.FullName
WB.Close SaveChanges:=False

'Restores screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End Sub




Private Sub CommandButtonSave_Click()
s = ActiveWorkbook.FullName
ActiveWorkbook.SaveAs FileName:=Left(s, Len(s) - 5) & " " & Format(Date, "ddmmyyyy") & ".xlsm", FileFormat:=52
End Sub