File format or file extension is not valid-CodePudding

Until recently I've been using Excel 2013 but I've now upgraded to office 365. The Excel file i'm referring to was built in 2013. I have a macro that will save the 'Report' tab and attach this to an email however the attachment returns the below error when attempting to open;

'Excel cannot open the file 'Document1.xlsm' because the file format or file extension is not valid. Verify that the file has not been corrupted and that the file extension matches the format of the file'

I've checked that both the original Excel file and attachment are the same file format. Below is the VBA - Any suggestions on what to try would be greatly appreciated :)

Sub EmailSelectedSheets()

Dim SourceWB As Workbook
Dim DestinWB As Workbook
Dim OutlookApp As Object
Dim OutlookMessage As Object
Dim TempFileName As Variant
Dim ExternalLinks As Variant
Dim TempFilePath As String
Dim FileExtStr As String
Dim DefaultName As String
Dim UserAnswer As Long
Dim x As Long

Dim Rng As Range, mystr As String

'Optimize Code
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.DisplayAlerts = False

'Copy only selected sheets into new workbook
  Set SourceWB = ActiveWorkbook
  Sheet5.Select
  SourceWB.Windows(1).SelectedSheets.Copy
  Set DestinWB = ActiveWorkbook


'Determine Temporary File Path
  TempFilePath = Environ$("temp") & "\"

'Determine Default File Name for InputBox

    TempFileName = "Test"
  If SourceWB.Saved Then
    DefaultName = Left(SourceWB.Name, InStrRev(SourceWB.Name, ".") - 1)
  Else
    DefaultName = SourceWB.Name
  End If

  
'Determine File Extension
  If SourceWB.Saved = True Then
    FileExtStr = "." & LCase(Right(SourceWB.Name, Len(SourceWB.Name) - InStrRev(SourceWB.Name, ".", , 1)))
  Else
    FileExtStr = ".xlsm"
  End If

'Break External Links
  ExternalLinks = DestinWB.LinkSources(Type:=xlLinkTypeExcelLinks)

    'Loop Through each External Link in ActiveWorkbook and Break it
      On Error Resume Next
        For x = 1 To UBound(ExternalLinks)
          DestinWB.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
        Next x
      On Error GoTo 0
      
'Save Temporary Workbook
  DestinWB.SaveCopyAs TempFilePath & TempFileName & FileExtStr

'Create Instance of Outlook
  On Error Resume Next
    Set OutlookApp = GetObject(Class:="Outlook.Application") 'Handles if Outlook is already open
  Err.Clear
    If OutlookApp Is Nothing Then Set OutlookApp = CreateObject(Class:="Outlook.Application") 'If not, open Outlook
    
    If Err.Number = 429 Then
      MsgBox "Outlook could not be found, aborting.", 16, "Outlook Not Found"
      GoTo ExitSub
    End If
  On Error GoTo 0

'Create a new email message
  Set OutlookMessage = OutlookApp.CreateItem(0)

'Create Outlook email with attachment

  On Error Resume Next
  
    Set Rng = Worksheets("Sheet4").Range("B7:B23")
    Set Rng = Worksheets("Sheet4").Range("B7:B23").Merge(True)
    mystr = Join(Application.Transpose(Rng.Value), ";")
  
    With OutlookMessage
     .SentOnBehalfOfName "[email protected]"
     .To = Sheet4.Range("B6").Text
     .CC = ""
     .BCC = ""
     .Subject = TempFileName
     .Body = "Please find attached the latest report." & vbNewLine & vbNewLine & "Kind regards"
     .Attachments.Add TempFilePath & TempFileName & FileExtStr
     .Display
    End With
  On Error GoTo 0

'Close & Delete the temporary file
  DestinWB.Close SaveChanges:=False
  Kill TempFilePath & TempFileName & FileExtStr

'Clear Memory
  Set OutlookMessage = Nothing
  Set OutlookApp = Nothing
  
'Optimize Code
ExitSub:
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  Application.DisplayAlerts = True

End Sub

CodePudding user response：

The original file and the attachment don't have the same format (the problem has nothing to do with sending the file per mail).

The original file is a file containing Macros, file type is (most likely) xlOpenXMLWorkbookMacroEnabled (52), extension is xlsm. You copy one of the sheets (sheet5) into a new workbook. What Excel does when you use the copy method is to create a workbook in the default file format (you can set this in the Excel Options under "Save"). In most cases this is format xlOpenXMLWorkbook (51), that is a macro-free workbook, extension xlsx.

What you now do is you save this workbook using the SaveCopyAs method. You provide a filename with an extension xlsm, but this doesn't change the file format. So you still have a file that is a macro-free workbook, but with the extension of a macro-enabled workbook. So extension and file format doesn't fit, and therefore you will get the error message that you (or whoever receives the mail) see.

You can easily proof this by removing the kill command, go to your temp folder and try to open the file - you will get the very same error message. Now rename the file to .xlsx and voilà, you can open the file.

There are some issues with your code. I guess you should refactor the code and split it to at least 2 routines: One saving the sheet as workbook and one that sends the mail. With that, you can test your functionality much easier because saving and sending are two separate tasks.

You don't need to select a sheet when you want to copy it (you hardly ever need to select or activate anything at all), and you shouldn't access the sheet via the Window-property. Simply use ActiveWorkbook.sheets(5).Copy.

After copying the sheet, you created a new workbook - you just need to save it. Don't use SaveCopyAs for that, use SaveAs. There, you can specify a filetype, and Excel will happily save the file in the format you want (and convert if necessary).
If you insist, you could save the copy as Macro-enabled, but as you send the file via mail, macro-free is usually the better option. Just be aware that filetype and extension fit. Or omit the extension at all, it that case Excel will add it for you automatically.

I refactored your code, have a look

Sub EmailSelectedSheets()
    'Optimize Code
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    Dim tmpFileName As String
    tmpFileName = SaveSheetAsTempFile(ThisWorkbook.Sheets(1)) ' Or whatever you want to save...
    
    SendMail tmpFileName

    Kill tmpFileName
    
ExitSub:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.DisplayAlerts = True
End Sub

Function SaveSheetAsTempFile(ws As Worksheet) As String
    Dim DestinWB As Workbook
    ws.Copy
    Set DestinWB = ActiveWorkbook
    
    ExternalLinks = DestinWB.LinkSources(Type:=xlLinkTypeExcelLinks)
    'Loop Through each External Link in ActiveWorkbook and Break it
    On Error Resume Next
        Dim x As Long
        For x = 1 To UBound(ExternalLinks)
            DestinWB.BreakLink Name:=ExternalLinks(x), Type:=xlLinkTypeExcelLinks
        Next x
    On Error GoTo 0
        
    Dim tmpFileName As String
    tmpFileName = Left(ws.Parent.Name, InStrRev(ws.Parent.Name, ".") - 1)
    tmpFileName = Environ$("temp") & "\" & tmpFileName & ".xlsx"
    
    DestinWB.SaveAs tmpFileName, xlOpenXMLWorkbook
    SaveSheetAsTempFile = tmpFileName

End Function

Sub SendMail(attachmentName As String)
    ' do your email sending stuff here...
    .Attachments.Add attachmentName 
End Sub