简体   繁体   English

在 Windows 和 Mac 上从 VBA 宏发送带有工作簿的电子邮件

[英]Send email with workbook from VBA macro on both Windows and Mac

My following code works correctly on PC but does not work on a Mac.我的以下代码在 PC 上正常运行,但在 Mac 上不起作用。 Instead of making two versions of the macro with separate buttons for Windows and Mac users, I would like the script to recognize the current OS and run the appropriate set of commands for that OS.我希望脚本能够识别当前的操作系统并为该操作系统运行适当的命令集,而不是为 Windows 和 Mac 用户制作带有单独按钮的两个版本的宏。

The macro creates an email with a workbook attachment.该宏创建带有工作簿附件的电子邮件。 The attachment is a temporary version of the ActiveWorkbook which is deleted after the email is sent.附件是 ActiveWorkbook 的临时版本,在发送电子邮件后会被删除。

The method I'm currently using to send an email is Windows CDO.我目前用来发送电子邮件的方法是 Windows CDO。 Are there any other considerations I should be aware of when its executing on MAC OSX with Office 2016?当它在带有 Office 2016 的 MAC OSX 上执行时,我还应该注意其他注意事项吗?

Private Message As CDO.Message
Private Attachment, Expression, Matches, FilenameMatch, i

Sub enviar_mail()

    Dim wb1 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String


    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 = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
    FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr

    On Error Resume Next

    Set Message = New CDO.Message
    Message.Subject = ActiveSheet.Range("G9").Value
    Message.From = ""
    Message.To = ""
    Message.CC = ""
    Message.HTMLBody = ActiveSheet.Range("A12").Value
    Message.AddAttachment TempFilePath & TempFileName & FileExtStr

    Dim Configuration
    Set Configuration = CreateObject("CDO.Configuration")
    Configuration.Load -1                        ' CDO Source Defaults
    Configuration.fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
    Configuration.fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.office365.com"
    Configuration.fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
    Configuration.fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
    Configuration.fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "name@email.com"
    Configuration.fields.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "*****"
    Configuration.fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True

    Configuration.fields.Update

    Set Message.Configuration = Configuration
    Message.Send

    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

So for determining the OS, you can use conditional compilation directives like so:因此,为了确定操作系统,您可以使用条件编译指令,如下所示:

#If Mac Then
    Debug.Print "I'm a Mac"
#Else
    Debug.Print "I'm not"
#End If

Sending mail is tricky on modern MacOS because of the security built in to the OS.由于操作系统内置的安全性,在现代 MacOS 上发送邮件很棘手。 CDO is strictly a Windows technology and does not apply here. CDO 严格来说是一种 Windows 技术,不适用于此处。 Most people go with writing a separate AppleScript file that is then executed by Excel.大多数人会编写一个单独的 AppleScript 文件,然后由 Excel 执行。 See this page for details on how to do it for both Outlook and Mail.app.有关如何为 Outlook 和 Mail.app 执行此操作的详细信息,请参阅此页面

It does of course involve extra steps to get the script into the user's computer in the first place, but AppleScript is pretty straightforward to understand.它当然首先需要额外的步骤来将脚本输入到用户的计算机中,但是 AppleScript 非常容易理解。 For example:例如:

tell application "Mail"
    set NewMail to (make new outgoing message with properties {subject:"My Subject"})
    tell NewMail
        set sender to "user@example.com"
        set content to "My email message"
        make new to recipient with properties {address:"someone@example.com"}
        send
    end tell
end tell

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM