amend code to extract .xls if not specified ob .xlsm if specified

[howard]

I have workbooks names in Col a on sheet1 that are .xls files if not specified
eg M_BR1 Sales (P). M_ERT Sales (P) Etc


I have specifiedthe .xlsm files

eg M_BR3 Sales (P).xslm




I have code below to create an email in outlook and to attach the sheet "summary", which works perfectly where the excel type is not specified. where the type .xlsm is specified , I get a run time error

The code that needs to be amended is as follows:

  s = "C:\Sales Reports" & rng.Value & ".xls"
    x = "C:\Sales Reports" & rng.Value & " summary" & ".xls"

See full code below

 Sub SendEmail()
    Dim OutlookApp As Object
    Dim mItem As Object
    Dim Cell As Range
    Dim Subj As String
    Dim EmailAddr As String
    Dim Body As String
    Dim Body1 As String
    
  
    
    '-------------------------------------------
    Dim s As String, wb As Workbook, ws As Worksheet, rng As Range, rng1 As Range, c As Range, LstRw As Long, x As String
    Application.DisplayAlerts = False
   
    
    Set rng = ActiveCell
    If rng.Column <> 1 Then
        MsgBox "You are not in the correct column"
        Exit Sub
    End If
    If rng.Value = "" Then
        MsgBox "Nothing selected"
        Exit Sub
    End If

    s = "C:\Sales Reports\" & rng.Value & ".xls"
    
    
    Set wb = Workbooks.Open(s)
    Set ws = wb.Sheets("summary")
    x = "C:\Sales Reports\" & rng.Value & " summary" & ".xls"
    ws.Copy
    ActiveWorkbook.SaveAs x
    ActiveWorkbook.Close
    wb.Close
    '----------------------------------------
    Set OutlookApp = CreateObject("Outlook.Application")
    EmailAddr = rng.Offset(, 1)
    Subj = rng & " -sales Report"
    
   
               
    Body = "Attached please find sales figures as well as prior year Sales as at  " & Format(Application.EoMonth(Date, -1), _
  "mmm yyyy") & " vs the Prior Year" & vbNewLine & vbNewLine
    Body = "Hi Guys" & vbNewLine & vbNewLine & Body
  Body = Body & "Regards" & vbNewLine & vbNewLine & "Howard"
    Set mItem = OutlookApp.createitem(0)

    With mItem
        .To = EmailAddr
        .Subject = Subj
             .Body = Body
        .attachments.Add x
        .display
        ' .send   'use this when you want to send.
    End With

ExitPoint:
    Set OLMsg = Nothing
    rng.Offset(, 2) = "Sent"
    
     rng.Offset(, 2).Font.Bold = True
     ActiveCell.Offset(1).Select
   

      
End Sub

It would be appreciated if someone could kindly amend my code

 

[jmacleary]

Hi there.
Try this:

If LCase(Right(Rng, 5)) <> ".xlsm" Then
    s = "C:\Sales Reports" & Rng.Value & ".xls"
    x = "C:\Sales Reports" & Rng.Value & " summary" & ".xls"
Else
    s = "C:\Sales Reports" & Rng.Value
    x = "C:\Sales Reports" & Left(Rng.Value, Len(Rng.Value) - 5) & " summary.xlsm"
End If

 

[howard]

Thanks for the help John


The code works perfectly for .xls files, but where the file is n .xlsm workbook, it comes up with a message "this extension cannot be used with this file type. change file extension in the file name ………..


The following code is highlighted

  ActiveWorkbook.SaveAs x

Kindly amend to accomodate .xlsm file types as well as .xls file types


your assistance in this regard is most appreciated