将.xlsm文件转换为.xls并通过Excel VBA通​​过Outlook发送附件

Question

我有一个代码，它将暂时保存工作簿，通过​​Outlook作为附件发送，然后删除文件。与其以.xlsm的形式发送，我不希望它以.xls的形式发送。我能够做到

FileExtStr = ".xls" 

但是当我尝试打开发送的附件时，它会显示以下消息：

  

“'orders.xls'的文件格式和扩展名不匹配。该文件可能已损坏或不安全。除非您信任它的来源，否则请不要打开它。是否要打开它？”

如何不仅更改格式的名称，还要将整个文件转换为xls以避免这种错误？

Sub EmailWithOutlook_workbook()

Dim wb1 As Workbook
Dim TempFilePath As String
Dim tempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object

Dim Wb2 As Workbook
Dim ws2 As Worksheet

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

Set wb1 = ActiveWorkbook

'Make a copy of the file/Open it/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
FileExtStr = ".xls"

tempFileName = File_Name_core & " " & Format(Now, "yyyy-mm-dd h-mm-ss")

wb1.SaveCopyAs TempFilePath & tempFileName & FileExtStr

Set Wb2 = Workbooks.Open(TempFilePath & tempFileName & FileExtStr)       

Wb2.Save
Wb2.Close

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

On Error Resume Next
With OutMail
    .To = email_to
    .CC = email_cc
    .bcc = email_bcc
    .Subject = email_subject
    .Body = email_body
    .Attachments.Add TempFilePath & tempFileName & FileExtStr
    .Display
End With
On Error GoTo 0

'Delete the temp file
Kill TempFilePath & tempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .EnableEvents = True
End With

End Sub

编辑：我已将代码修改为

Sub EmailWithOutlook_workbook()

Dim wb1 As Workbook
Dim TempFilePath As String
Dim tempFileName As String
Dim FileExtStr As String
Dim OutApp As Object
Dim OutMail As Object

Dim Wb2 As Workbook
Dim ws2 As Worksheet

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

Set wb1 = ActiveWorkbook

'Make a copy of the file/Open it/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))
'   tempFileName = Left(wb1.Name, Len(wb1.Name) - Len(FileExtStr)) & " " & Format(Now, "yyyy-mm-dd h-mm-ss")
tempFileName = File_Name_core & " " & Format(Now, "yyyy-mm-dd h-mm-ss")

'////////////MODIFIED PART/////////////
wb1.Sheets.Copy 'creates new workbook without macros"
'The New workbook copy is now the Active workbook
wb1.SaveAs TempFilePath & tempFileName, FileFormat:=51
wb1.Close
'////////////////////////////////////
Set Wb2 = Workbooks.Open(TempFilePath & tempFileName, , , FileFormat:=51)

Wb2.Save
Wb2.Close

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

On Error Resume Next
With OutMail
    .To = email_to
    .CC = email_cc
    .bcc = email_bcc
    .Subject = email_subject
    .Body = email_body
    .Attachments.Add TempFilePath & tempFileName & FileExtStr
    .Display
End With
On Error GoTo 0

'Delete the temp file
Kill TempFilePath & tempFileName

Set OutMail = Nothing
Set OutApp = Nothing

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
    .EnableEvents = True
End With

End Sub

但是，现在这产生了一个问题，即我的工作簿被重命名为附件（这是因为我要保存文件而不是保存副本？）。我希望工作簿在用户运行代码之前具有相同的原始名称...