Code is placing extra file extension on Outlook attachments. Can anyone help me remove it?

mikenelena

Board Regular
Joined
Mar 5, 2018
Messages
139
Office Version
  1. 365
Platform
  1. Windows
Here is the code that I've gathered together for this. As the subject mentions, the code is placing an extra file extension on the names of Outlook attachments. The files still open, but it looks silly and I'd like to correct it. Can anyone tell me which lines need to be changed/added to correct this?

Much appreciated, thanks!

Code:
Sub SendWorkSheet()


Dim xFile As String
Dim xFormat As Long
Dim Wb As Workbook
Dim Wb2 As Workbook
Dim FilePath As String
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object


    On Error Resume Next
        Application.ScreenUpdating = False


    Set Wb = Application.ActiveWorkbook
        ActiveSheet.Copy


    Set Wb2 = Application.ActiveWorkbook


Select Case Wb.FileFormat
    
    Case xlOpenXMLWorkbook:
        xFile = ".xlsx"
        xFormat = xlOpenXMLWorkbook
    Case xlOpenXMLWorkbookMacroEnabled:
        If Wb2.HasVBProject Then
            xFile = ".xlsm"
            xFormat = xlOpenXMLWorkbookMacroEnabled
        Else
            xFile = ".xlsx"
            xFormat = xlOpenXMLWorkbook
        End If


    Case Excel8:
        xFile = ".xls"
        xFormat = Excel8
    Case xlExcel12:
        xFile = ".xlsb"
        xFormat = xlExcel12
End Select


FilePath = Environ$("temp") & "\"
FileName = Wb.Name '& Format (Now, "dd-mmm-yy")


Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(olMailItem)


Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
emailbody = "****** style=font-size:11pt;font-family:Calibri>My mileage report is attached.</BODY>"


With OutlookMail
    .display
    .To = "someone@somewhere"
    .CC = ""
    .BCC = ""
    .Subject = "Mileage Report"
    .HTMLBody = emailbody & "<br>" & .HTMLBody
    .Attachments.Add Wb2.FullName
    '.Send


End With
Wb2.Close
Kill FilePath & FileName & xFile
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Application.ScreenUpdating = True


End Sub
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Hello

Code:
Sub SendWorkSheet()
Dim xFile$, xFormat As Long, emailbody$, wb As Workbook, FilePath$, _
FileName$, OutlookApp As Object, OutlookMail As Object
Set wb = Application.ActiveWorkbook
ActiveSheet.Copy
Select Case wb.FileFormat
    Case xlOpenXMLWorkbook
        xFile = ".xlsx"
        xFormat = xlOpenXMLWorkbook
    Case xlOpenXMLWorkbookMacroEnabled
        If wb.HasVBProject Then
            xFile = ".xlsm"
            xFormat = xlOpenXMLWorkbookMacroEnabled
        Else
            xFile = ".xlsx"
            xFormat = xlOpenXMLWorkbook
        End If
    Case xlExcel8
        xFile = ".xls"
        xFormat = xlExcel8
    Case xlExcel12
        xFile = ".xlsb"
        xFormat = xlExcel12
End Select
FilePath = Environ$("temp") & "\"
FileName = wb.Name       '& Format (Now, "dd-mmm-yy")
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
wb.SaveAs FilePath & FileName, FileFormat:=xFormat
emailbody = "Report attached."
With OutlookMail
    .To = "[EMAIL="someone@somewhere"]someone@somewhere[/EMAIL]"
    .cc = ""
    .BCC = ""
    .Subject = "Mileage Report"
    .HTMLBody = emailbody & "" & .HTMLBody
    .Attachments.Add wb.FullName
    .Display
End With
'Kill FilePath & FileName
Set OutlookMail = Nothing: Set OutlookApp = Nothing
End Sub
 
Upvote 0

Forum statistics

Threads
1,223,228
Messages
6,170,871
Members
452,363
Latest member
merico17

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