Исправлена ​​ошибка форматирования при сохранении с VBA

Question

У меня есть этот VBA, чтобы сохранить копию во временном файле и отправить ее по электронной почте в Outlook.При отправке файла по электронной почте выдается сообщение об ошибке.Там написано

Расширение файла и формат файла не совпадают.

Ниже - мой код, если кто-нибудь может сказать мне, где я неправ:

Sub EmailWorkbook()
    Dim wb1 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim OutApp As Object
    Dim OutMail As Object

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

    Set wb1 = ActiveWorkbook

    'Make a copy of the file/Open it/Mail it/Delete it
    'If you want to change the file name then change only TempFileName
    TempFilePath = Environ$("temp") & "\"
    TempFileName = "Daily Sales" & " " & Format(Now, "dd-mmm") & FileExtStr
    FileExtStr = ".xlxs"
    FileFormatNum = 51


    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .to = "myemail"
        .CC = ""
        .BCC = ""
        .Subject = "title"
        .Body = "Hi there"
        .Attachments.Add TempFilePath & TempFileName & FileExtStr
        '.Attachments.Add ("C:\test.txt")
        .Send   'or use .Display
    End With
    On Error GoTo 0

    'Delete the file
    Kill TempFilePath & TempFileName & FileExtStr
    Set OutMail = Nothing
    Set OutApp = Nothing

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

Answer 1

Попробуйте это:

Sub EmailWorkbook()
Dim wb1 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim TempFileNameAndPath As String
Dim OutApp As Object
Dim OutMail As Object

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

Set wb1 = ActiveWorkbook

'Make a copy of the file/Open it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = "Daily Sales " & Format(Now, "dd-mmm") & FileExtStr
FileExtStr = ".xlsx"
TempFileNameAndPath = TempFilePath & TempFileName


wb1.SaveCopyAs FileName:= TempFileNameAndPath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
    .to = "myemail"
    .CC = ""
    .BCC = ""
    .Subject = "title"
    .Body = "Hi there"
    .Attachments.Add TempFileNameAndPath
    '.Attachments.Add ("C:\test.txt")
    .Send   'or use .Display
End With
On Error GoTo 0

'Delete the file
Kill TempFileNameAndPath
Set OutMail = Nothing
Set OutApp = Nothing

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