Change Attachments from XLSM to XLSX in mail

[KlausW]

Hi every one
I use this VBA code to send the Workbook I'm in by email. The file is sent as a file containing macro (xlsm), but I would like it to be sent without macro (xlsx). Some who can help.

Any help will be appreciated
Best Regards
Klaus W

Sub Rektangelafrundedehjørner2_Klik()

Dim OutlookApp As Object
Dim OutlookMail As Object
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
On Error Resume Next
With OutlookMail
    .To = Range("o1").Text
    .CC = ""
    .BCC = ""
    .Subject = Range("k9").Value
    .Body = "17:10"
    .Attachments.Add Application.ActiveWorkbook.FullName
    .Send
End With
Set OutlookMail = Nothing
Set OutlookApp = Nothing

End Sub

 

[Micron]

Try (of the top of my head)
Dim strFileName As String

strFileName = Application.ActiveWorkbook.FullName
strFileName = Replace(strFileName,".xlsm", ".xlsx")

then .Attachments.Add strFileName

If it works, strFileName could probably be created on 1 line if preferred.
EDIT - corrected missing dot for .xlsx
I think you can get away with changing the extension to create the xlsx file, but I don't know what that will mean to your users. I'd test by sending myself a file before rolling it out. You might find that if anyone knows/discovers there is code in the file, they will be able to access it by changing the extension back. You might want to verify that too.

 

[KlausW]

Try (of the top of my head)
Dim strFileName As String

strFileName = Application.ActiveWorkbook.FullName
strFileName = Replace(strFileName,".xlsm", ".xlsx")

then .Attachments.Add strFileName

If it works, strFileName could probably be created on 1 line if preferred.
EDIT - corrected missing dot for .xlsx
I think you can get away with changing the extension to create the xlsx file, but I don't know what that will mean to your users. I'd test by sending myself a file before rolling it out. You might find that if anyone knows/discovers there is code in the file, they will be able to access it by changing the extension back. You might want to verify that too.

Hi Micron, I've tried putting in your code but it won't take the file. I can't figure out where to put your code. Apparently. Klaus W

 

[Micron]

Totally overlooked the fact that the filename would have to exist in order to attach it. If you could change the name after attaching I don't know how, but I seriously doubt you can. You would have to do a SaveAs then attach that. Presumably you'll use vba to save a file with the properties you need. Here is what I came up with - seems to work. If the file exists, it still works (presumably it overwrites it). I had to test with my own email, then remove that from the code.

Sub Rektangelafrundedehjørner2_Klik()
Dim strPath As String
Dim OutlookApp As Object, OutlookMail As Object

On Error GoTo errHandler
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
strPath = Replace(ThisWorkbook.FullName, ".xlsm", ".xlsx")
Application.DisplayAlerts = False
ThisWorkbook.SaveAs strPath, 51
Application.DisplayAlerts = True

With OutlookMail
    .To = Range("o1").Text
    .CC = ""
    .BCC = ""
    .Subject = Range("k9").Value
    .Body = "17:10"
    .Attachments.Add strPath
    .Send
End With

exitHere:
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Application.DisplayAlerts = True
Exit Sub

errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere
End Sub

EDIT - be careful of where you use Resume Next - it will often mask issues. An error handler is usually better.

 

[KlausW]

Totally overlooked the fact that the filename would have to exist in order to attach it. If you could change the name after attaching I don't know how, but I seriously doubt you can. You would have to do a SaveAs then attach that. Presumably you'll use vba to save a file with the properties you need. Here is what I came up with - seems to work. If the file exists, it still works (presumably it overwrites it). I had to test with my own email, then remove that from the code.

Sub Rektangelafrundedehjørner2_Klik()
Dim strPath As String
Dim OutlookApp As Object, OutlookMail As Object

On Error GoTo errHandler
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
strPath = Replace(ThisWorkbook.FullName, ".xlsm", ".xlsx")
Application.DisplayAlerts = False
ThisWorkbook.SaveAs strPath, 51
Application.DisplayAlerts = True

With OutlookMail
    .To = Range("o1").Text
    .CC = ""
    .BCC = ""
    .Subject = Range("k9").Value
    .Body = "17:10"
    .Attachments.Add strPath
    .Send
End With

exitHere:
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Application.DisplayAlerts = True
Exit Sub

errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere
End Sub

EDIT - be careful of where you use Resume Next - it will often mask issues. An error handler is usually better.

Totally overlooked the fact that the filename would have to exist in order to attach it. If you could change the name after attaching I don't know how, but I seriously doubt you can. You would have to do a SaveAs then attach that. Presumably you'll use vba to save a file with the properties you need. Here is what I came up with - seems to work. If the file exists, it still works (presumably it overwrites it). I had to test with my own email, then remove that from the code.

Sub Rektangelafrundedehjørner2_Klik()
Dim strPath As String
Dim OutlookApp As Object, OutlookMail As Object

On Error GoTo errHandler
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
strPath = Replace(ThisWorkbook.FullName, ".xlsm", ".xlsx")
Application.DisplayAlerts = False
ThisWorkbook.SaveAs strPath, 51
Application.DisplayAlerts = True

With OutlookMail
    .To = Range("o1").Text
    .CC = ""
    .BCC = ""
    .Subject = Range("k9").Value
    .Body = "17:10"
    .Attachments.Add strPath
    .Send
End With

exitHere:
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Application.DisplayAlerts = True
Exit Sub

errHandler:
MsgBox "Error " & Err.Number & ": " & Err.Description
Resume exitHere
End Sub

EDIT - be careful of where you use Resume Next - it will often mask issues. An error handler is usually better.

Hi Micron
thank you very much for your help. Just as it should be. Good day. Best Regards Klaus W

 

[Micron]

Glad I could help & thanks for the recognition.