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

时间:2018-08-23 16:05:01

标签: excel vba windows macos cdo

我的以下代码在PC上正常工作,但在Mac上不工作。我希望脚本可以识别当前操作系统并为该操作系统运行适当的命令集,而不是使用两个单独的按钮来为Windows和Mac用户创建宏的两个版本。

宏将创建带有工作簿附件的电子邮件。附件是ActiveWorkbook的临时版本,在发送电子邮件后将被删除。

我当前用于发送电子邮件的方法是Windows CDO。在Mac OSX上与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 个答案:

答案 0 :(得分:1)

因此,要确定操作系统,您可以像这样使用conditional compilation directives

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

在现代MacOS上,由于操作系统内置的安全性,发送邮件非常棘手。 CDO严格来说是Windows技术,在这里不适用。大多数人会编写一个单独的AppleScript文件,然后由Excel执行。有关如何针对Outlook和Mail.app进行操作的详细信息,请参见this page

它当然确实需要额外的步骤才能将脚本首先放入用户的计算机,但是AppleScript非常容易理解。例如:

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