Open XLTM file > Click on Macro button > send as XLSM attachment in a outlook message

get2guy

New Member
Joined
Jan 25, 2017
Messages
9
Hi VBA's,


I originally had an XLSM file with a macro button to send the file as attachment in an outlook message.
I wish to save this XLSM as a template (XLTM ) but when i did that the sent attachment is without file extension. and i need it to be with XLSM


Can you please tell me what should be added to the code?




My send mail VBA code:
Code:
Sub Mail_Order_To_Relavant_Purchaser()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object


    Set wb1 = ActiveWorkbook
    If Val(Application.Version) >= 12 Then
        If wb1.FileFormat = 51 And wb1.HasVBProject = True Then
            MsgBox "There is VBA code in this xlsx file. There will" & vbNewLine & _
                   "be no VBA code in the file you send. Save the" & vbNewLine & _
                   "file as a macro-enabled (. Xlsm) and then retry the macro.", vbInformation
            Exit Sub
        End If
    End If


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


    ' Make a copy of the file.
    ' If you want to change the file name then change only TempFileName variable.
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mm-yy hh-mm-ss")
    FileExtStr = "." & LCase(Right(wb1.Name, _
                                   Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))


    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
    Set wb2 = Workbooks.Open(TempFilePath & TempFileName & FileExtStr)


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


    On Error Resume Next
   ' Change the mail address and subject in the macro before you run this procedure.
    With OutMail
        .to = ThisWorkbook.Sheets("Order").Range("N10").Value
        .CC = ""
        .BCC = ""
        .Subject = "New Order"
        .Body = "New Order"
        .Attachments.Add wb2.FullName
        .display
        ' You can add other files by uncommenting the following line.
        '.Attachments.Add ("C:\test.txt")
        ' In place of the following statement, you can use ".Display" to
        ' display the mail.
        'Send
    End With
    On Error GoTo 0


    wb2.Close SaveChanges:=False


    ' Delete the file.
    Kill TempFilePath & TempFileName & FileExtStr


    Set OutMail = Nothing
    Set OutApp = Nothing


    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
MsgBox "Sent to Purchase Department", vbOKOnly
ActiveWorkbook.Close True


End Sub
 

Excel Facts

Ambidextrous Undo
Undo last command with Ctrl+Z or Alt+Backspace. If you use the Undo icon in the QAT, open the drop-down arrow to undo up to 100 steps.
It was easier than expected.
I replaced this line :
Code:
FileExtStr = "." & LCase(Right(wb1.Name, _
                                   Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
With this simple line:
Code:
FileExtStr = "." & "xlsm"
 
Upvote 0

Forum statistics

Threads
1,223,246
Messages
6,170,996
Members
452,373
Latest member
TimReeks

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top