Question

您好Iam使用以下代码作为示例通过SMTP发送带附件的邮件，但它发送的附件是XLSM格式我需要它是XLSX（非宏）格式。请帮助我解决这个问题。

Option Explicit

'This procedure will mail the whole workbook
'You can 't send a Workbook that is open with CDO.
'That's why it use SaveCopyAs to save it with another name and send that file.

Sub CDO_Mail_Workbook()
'Working in 2000-2007
    Dim wb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim iMsg As Object
    Dim iConf As Object
    '    Dim Flds As Variant

Set wb = ActiveWorkbook

If Val(Application.Version) >= 12 Then
    If wb.FileFormat = 51 And wb.HasVBProject = True Then
        MsgBox "There is VBA code in this xlsx file, there will be no VBA code in the file you send." & vbNewLine & _
               "Save the file first as xlsm and then try the macro again.", vbInformation
        Exit Sub
    End If
End If

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

'Make a copy of the file/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & "\"
TempFileName = "Copy of " & wb.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
FileExtStr = "." & LCase(Right(wb.Name, Len(wb.Name) - InStrRev(wb.Name, ".", , 1)))

wb.SaveCopyAs TempFilePath & TempFileName & FileExtStr

Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")

'    iConf.Load -1    ' CDO Source Defaults
'    Set Flds = iConf.Fields
'    With Flds
'        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
'        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "Fill in your SMTP server here"
'        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
'        .Update
'    End With

With iMsg
    Set .Configuration = iConf
    .To = "ron@debruin.nl"
    .CC = ""
    .BCC = ""
    .From = """Ron"" <ron@something.nl>"
    .Subject = "This is a test"
    .TextBody = "This is the body text"
    .AddAttachment TempFilePath & TempFileName & FileExtStr
    .Send
End With

'If you not want to delete the file you send delete this line
Kill TempFilePath & TempFileName & FileExtStr

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

Answer 1

我认为您需要做的是将此代码驻留在加载项中。这样你就不会试图通过电子邮件发送带有代码的现有文件。

Answer 2

您正在发送正在运行代码的工作簿，因此它必须是.xlsm，因此您发送它您必须创建没有宏的工作簿副本，然后发送此副本或将宏移动到PERSONAL（假设您发布的宏是工作簿中包含的唯一代码）

需要使用CDO邮件以XLSX格式发送附件

2 个答案: