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

时光怂恿深爱的人放手 提交于 2019-12-02 14:58:25

问题


My following code works correctly on PC but does not work on a 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.

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.

The method I'm currently using to send an email is Windows CDO. Are there any other considerations I should be aware of when its executing on MAC OSX with Office 2016?

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

回答1:


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. CDO is strictly a Windows technology and does not apply here. Most people go with writing a separate AppleScript file that is then executed by Excel. See this page for details on how to do it for both Outlook and 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. 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


来源:https://stackoverflow.com/questions/51990005/send-email-with-workbook-from-vba-macro-on-both-windows-and-mac

易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!