如何从Excel for Mac发送Excel工作表的电子邮件

时间:2017-03-29 20:31:14

标签: excel macos excel-vba excel-vba-mac vba

我想在每天的特定时间从excel发送自动电子邮件,并将工作表作为电子邮件正文中的消息。我使用的是Excel for Mac,但我无法在此找到“向收件人发送电子邮件”选项。以下vba脚本也不起作用:

Function MailFromMacwithOutlook(bodycontent As String, mailsubject As String, _
            toaddress As String, ccaddress As String, bccaddress As String, _
            attachment As String, displaymail As Boolean)



    Dim scriptToRun As String

    scriptToRun = scriptToRun & "tell application " & _
                  Chr(34) & "Microsoft Outlook" & Chr(34) & Chr(13)

    scriptToRun = scriptToRun & _
     "set NewMail to make new outgoing message with properties" & _
       "{content:""" & bodycontent & """, subject:""" & mailsubject & """}" & Chr(13)

    If toaddress <> "" Then scriptToRun = scriptToRun & _
       "make new to recipient at NewMail with properties" & _
       "{email address:{address:""" & toaddress & """}}" & Chr(13)

    If ccaddress <> "" Then scriptToRun = scriptToRun & _
       "make new cc recipient at NewMail with properties" & _
       "{email address:{address:""" & ccaddress & """}}" & Chr(13)

    If bccaddress <> "" Then scriptToRun = scriptToRun & _
       "make new bcc recipient at NewMail with properties" & _
       "{email address:{address:""" & bccaddress & """}}" & Chr(13)

    If attachment <> "" Then
     scriptToRun = scriptToRun & "make new attachment at NewMail with properties" & _
              "{file:""" & attachment & """ as alias}" & Chr(13)
    End If

    If displaymail = False Then
        scriptToRun = scriptToRun & "send NewMail" & Chr(13)
    Else
        scriptToRun = scriptToRun & "open NewMail" & Chr(13)
    End If
    scriptToRun = scriptToRun & "end tell" & Chr(13)

    If Len(toaddress) + Len(ccaddress) + Len(bccaddress) = 0 Or mailsubject = "" Then
        MsgBox "There is no To, CC or BCC address or Subject for this mail"
        Exit Function
    Else
        On Error Resume Next
        MacScript (scriptToRun)
        On Error GoTo 0
    End If
End Function

Function MailFromMacWithMail(bodycontent As String, mailsubject As String, _
           toaddress As String, ccaddress As String, bccaddress As String, _
                attachment As String, displaymail As Boolean)



    Dim scriptToRun As String

    scriptToRun = scriptToRun & "tell application " & _
                  Chr(34) & "Mail" & Chr(34) & Chr(13)

    scriptToRun = scriptToRun & _
         "set NewMail to make new outgoing message with properties " & _
            "{content:""" & bodycontent & """, subject:""" & _
               mailsubject & """ , visible:true}" & Chr(13)

    scriptToRun = scriptToRun & "tell NewMail" & Chr(13)

    If toaddress <> "" Then scriptToRun = scriptToRun & _
       "make new to recipient at end of to recipients with properties " & _
       "{address:""" & toaddress & """}" & Chr(13)

    If ccaddress <> "" Then scriptToRun = scriptToRun & _
       "make new cc recipient at end of cc recipients with properties " & _
       "{address:""" & ccaddress & """}" & Chr(13)

    If bccaddress <> "" Then scriptToRun = scriptToRun & _
       "make new bcc recipient at end of bcc recipients with properties " & _
       "{address:""" & bccaddress & """}" & Chr(13)

    If attachment <> "" Then
        scriptToRun = scriptToRun & "tell content" & Chr(13)
        scriptToRun = scriptToRun & "make new attachment with properties " & _
                      "{file name:""" & attachment & """ as alias} " & _
                      "at after the last paragraph" & Chr(13)
        scriptToRun = scriptToRun & "end tell" & Chr(13)
    End If

    If displaymail = False Then scriptToRun = scriptToRun & "send" & Chr(13)
    scriptToRun = scriptToRun & "end tell" & Chr(13)
    scriptToRun = scriptToRun & "end tell"

    If Len(toaddress) + Len(ccaddress) + Len(bccaddress) = 0 Or mailsubject = "" Then
        MsgBox "There is no To, CC or BCC address or Subject for this mail"
        Exit Function
    Else
        On Error Resume Next
        MacScript (scriptToRun)
        On Error GoTo 0
    End If
End Function

Function KillFileOnMac(Filestr As String)


'The VBA Kill command on a Mac will not work with long file names(28+ characters)
    Dim ScriptToKillFile As String
    ScriptToKillFile = ScriptToKillFile & "tell application " & Chr(34) & _
                       "Finder" & Chr(34) & Chr(13)
    ScriptToKillFile = ScriptToKillFile & _
                       "do shell script ""rm "" & quoted form of posix path of " & _
                       Chr(34) & Filestr & Chr(34) & Chr(13)
    ScriptToKillFile = ScriptToKillFile & "end tell"

    On Error Resume Next
    MacScript (ScriptToKillFile)
    On Error GoTo 0
End Function

而且:

Sub Mail_workbook_Excel2011_1()
'For Excel 2011 for the Mac and Apple Mail
'Note: The workbook must be saved once
    Dim wb As Workbook

    If Val(Application.Version) < 14 Then Exit Sub

    Set wb = ActiveWorkbook
    With wb
        MailFromMacwithOutlook bodycontent:="Hi there", _
                    mailsubject:="Testing", _
                    toaddress:="something@something.com", _
                    ccaddress:="", _
                    bccaddress:="", _
                    attachment:=.FullName, _
                    displaymail:=True
    End With
    Set wb = Nothing

End Sub

有人可以帮我解决如何在Excel for Mac中完成这项工作吗?

0 个答案:

没有答案