email Macro Subject line

[howard]

I have the following code to enable a user to attach a workbook and to email this

I would like the section of code containing .Subject = to contain the "Summary Sales figures for + the name of the workbook attached or eg if name of workbook attached is BR.xls then .Subject = must appears as
.Subject = "Summary Sales figures for Br.xls


See full Code below

 Sub SendFiles()
    Dim lCount As Long
    Dim vFilenames As Variant
    Dim sPath As String
    Dim lFilecount As Long
    Dim sFullName As String
    sPath = "C:\Sales Reports\"
    ChDrive sPath
    ChDir sPath
    vFilenames = Application.GetOpenFilename("Microsoft Excel files (*.xls),*.xls", , "Please select the file(s) to open", , True)
    If TypeName(vFilenames) = "Boolean" Then Exit Sub
    For lCount = LBound(vFilenames) To UBound(vFilenames)
        Workbooks.Open vFilenames(lCount), UpdateLinks:=False
        Application.DisplayAlerts = False
        Application.CutCopyMode = False
       Sheets(Array("summary")).Copy
        ActiveWorkbook.SaveAs Replace(vFilenames(lCount), ".xls", "") & ".summary.xls", FileFormat:=xlNormal
        vFilenames(lCount) = ActiveWorkbook.FullName
        Application.ScreenUpdating = False
        For Each sht In Sheets(Array("summary"))
        Sheets(sht.Name).UsedRange.Copy
        Sheets(sht.Name).Range("a1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
        Next
        Application.ScreenUpdating = True
        ActiveWorkbook.Close True
        Application.DisplayAlerts = True
        Application.CutCopyMode = True
    Next
      Mailfiles "Dav@Ampin.com", vFilenames
    For lCount = LBound(vFilenames) To UBound(vFilenames)
Kill vFilenames(lCount)
Next
   ActiveWorkbook.Close False
End Sub

Sub Mailfiles(sMailAddress As String, vFiles As Variant)
    Dim oMailItem As Object
    Dim oOLapp As Object
    Dim lCt As Long

    Set oOLapp = CreateObject("Outlook.application")
    Set oMailItem = oOLapp.CreateItem(0)
    With oMailItem
        .To = sMailAddress
        .Subject = "Summary Sales Figures"
       .body = "Attached please find Sales report for  " & Format(Month(Date) - 1 & " " & Year(Date), "mmm yyyy") & " vs the Prior Year" & vbNewLine & vbNewLine
                  
              .body = .body & "Regards" & vbNewLine & vbNewLine
.body = .body & ""

 

[howard]

I also posted on Macro to add workbook name once attached to sublet line in outlook