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

使用VBA保存时修复格式错误

1 个答案: