Rename Workbook before sending email with Macros based on Cell Values

[GamerNeelie]

I Have an email script that will send a email using a button

I need to be able to rename the file based on 3 Cell values before it sends the email

Sub Email()
'This example send the last saved version of the Activeworkbook
    Dim OutApp As Object
    Dim OutMail As Object

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

    On Error Resume Next
    With OutMail
        .To = Range("X4").Value
        .CC = ""
        .BCC = ""
        .Subject = "Report - " & Range("X11").Value & " - " & Range("X9").Value & " - " & Range("E6").Value
        .Body = "Please find Attached our Report for " & Range("X11").Value & vbNewLine & vbNewLine & _
                "Company: " & Range("X9").Value & vbNewLine & _
                "ID: " & Range("E6").Value

        .Attachments.Add ActiveWorkbook.FullName
        '.Send
        .Display
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
    'MsgBox "Email Sent "
End Sub

I have it sending the current workbook and filename but there is 100 business that will be sending this email to a master address so I need to be able to rename the files based on 3 cell values
A1 = Company ID
A2 = Company Name
A3 = Other Text

Thanks.

 

[GamerNeelie]

Ok I took the " - " off at the end and now it has saved the file as the correct information

Its now getting an error on the line further down (.Attachments.Add ThisWorkbook.Path & Application.PathSeparator & filename1 & ".xlsm")

 

[GamerNeelie]

The file is saving and giving it the required file name so that all working fine. Its just stopping when it tries to find the file and add it to email

 

[GamerNeelie]

Sorry I have fixed it now. I was playing about with the way it saves the file name and didnt copy it to the 2nd "filename1" line so they wasnt equal

it is all working perfect now

thank you so much for you help :D

 

[Logit]

Glad you have an answer.