Sending email via VBA with attachment

[redspanna]

Hey all

I've managed to edit this code found online to pretty much complete the task I want.
However , I would prefer the copied file name to be the same as the sheet its copying and NOT the workbook name

At the moment the workbook name is NDA.v19 and the copied sheet name is Desktop Dashboard

So the code below will copy and send the email with the attached (new) file called NDA.v19 Mar 2022, however I would like it to be called Desktop Dashboard Mar 2022 (note the Mar 2022 date is taken from a formula)

The current code is as follows...

Option Explicit

Sub CDO_Mail_ActiveSheet_Or_Sheets()
    'Working in 97-2007
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Sourcewb As Workbook
    Dim Destwb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim iMsg As Object
    Dim iConf As Object
    Dim Flds As Variant

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook

    'Copy the ActiveSheet to a new workbook
    ActiveSheet.Copy

    Set Destwb = ActiveWorkbook

    'Determine the Excel version and file extension/format
    With Destwb
        If Val(Application.Version) < 12 Then
            'You use Excel 97-2003
            FileExtStr = ".xls": FileFormatNum = -4143
        Else
            'You use Excel 2007
            'We exit the sub when your answer is NO in the security dialog that you only
            'see  when you copy a sheet from a xlsm file with macro's disabled.
            If Sourcewb.Name = .Name Then
                With Application
                    .ScreenUpdating = True
                    .EnableEvents = True
                End With
                MsgBox "Your answer is NO in the security dialog"
                Exit Sub
            Else
                Select Case Sourcewb.FileFormat
                    Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
                    Case 52:
                        If .HasVBProject Then
                            FileExtStr = ".xlsm": FileFormatNum = 52
                        Else
                            FileExtStr = ".xlsx": FileFormatNum = 51
                        End If
                    Case 56: FileExtStr = ".xls": FileFormatNum = 56
                    Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
                End Select
            End If
        End If
    End With

   
    'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = Sourcewb.Name & " " & Format(Now, "mmm yyyy")
 

    With Destwb
        .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
        .Close savechanges:=False
    End With

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")

        iConf.Load -1    ' CDO Source Defaults
        Set Flds = iConf.Fields
        With Flds
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mail.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = ###
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "@email.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "*"

            .Update
        End With

    With iMsg
        Set .Configuration = iConf
        .To = Sheets("Workings").Range("E52").Value '"joebloggs@email.com"
        .CC = ""
        .BCC = ""
        .From = """joebloggs@email.com"" <joebloggs@.com>"
        .Subject = "Desktop Dashboard"
        .TextBody = "Please find attached a copy of the requested Desktop Dashboard"
        .AddAttachment TempFilePath & TempFileName & FileExtStr
        .send
    End With


    'Delete the file you have send
    Kill TempFilePath & TempFileName & FileExtStr

    Set iMsg = Nothing
    Set iConf = Nothing
    Set Flds = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    
    UserForm4.Hide
    MsgBox "Desktop Dashboard has successfully been sent to" & vbNewLine & _
    vbNewLine & Sheets("Workings").Range("E52").Value
End Sub

Appreciate any help and thanks in advance

 

[redspanna]

Think I figured it out...

Changed this part of the code

 'Save the new workbook/Mail it/Delete it
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Desktop Dashboard" & " " & Format(Now, "mmm yyyy")