如何使用excel宏(vba)退出邮件(在mac上)?

时间:2017-01-22 06:51:55

标签: excel vba excel-vba email

有没有办法运行一个宏来退出mac上的邮件应用程序? 我正在运行此代码来打开邮件并发送电子邮件:

Function MailFromMacWithMail(bodycontent As String, mailsubject As String, _
                         toaddress As String, ccaddress As String, bccaddress As String, _
                         attachment As String, displaymail As Boolean)
'Ron de Bruin, function to Mail with Apple Mail, last update 6-Dec-2015
'Add a delay line to fix the attachment bug in El Capitan
'If it still not attach the attachment try to change the 1 to 2 in the delay line
'If you not use El Capitan you can change it to 0 or delete the line in this function
'You can use more mail addresses now in the To, CC and BCC, and it add the default signature
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 " & _
              "{subject:""" & mailsubject & """ , visible:true}" & Chr(13)

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

scriptToRun = scriptToRun & "set defaultSig to message signature" & Chr(13)
scriptToRun = scriptToRun & "set content to """ & bodycontent & """ & return & return" & Chr(13)

scriptToRun = scriptToRun & "set message signature to defaultSig" & Chr(13)

If toaddress <> "" Then
    scriptToRun = scriptToRun & "set toaddressList to {" & _
              Chr(34) & Replace(toaddress, ",", """,""") & Chr(34) & "}" & Chr(13)
    scriptToRun = scriptToRun & "repeat with i from 1 to count toaddressList" & Chr(13)
    scriptToRun = scriptToRun & "make new to recipient at end of to recipients with " & _
                 "properties {address:{item i of toaddressList}}" & Chr(13)
    scriptToRun = scriptToRun & "end repeat" & Chr(13)
End If

If ccaddress <> "" Then
    scriptToRun = scriptToRun & "set ccaddressList to {" & _
              Chr(34) & Replace(ccaddress, ",", """,""") & Chr(34) & "}" & Chr(13)
    scriptToRun = scriptToRun & "repeat with i from 1 to count ccaddressList" & Chr(13)
    scriptToRun = scriptToRun & "make new cc recipient at end of cc recipients with " & _
                 "properties {address:{item i of ccaddressList}}" & Chr(13)
    scriptToRun = scriptToRun & "end repeat" & Chr(13)
End If

If bccaddress <> "" Then
    scriptToRun = scriptToRun & "set bccaddressList to {" & _
              Chr(34) & Replace(bccaddress, ",", """,""") & Chr(34) & "}" & Chr(13)
    scriptToRun = scriptToRun & "repeat with i from 1 to count bccaddressList" & Chr(13)
    scriptToRun = scriptToRun & "make new bcc recipient at end of bcc recipients with " & _
                 "properties {address:{item i of bccaddressList}}" & Chr(13)
    scriptToRun = scriptToRun & "end repeat" & Chr(13)
End If

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 & "Delay 1" & Chr(13)
    scriptToRun = scriptToRun & "end tell" & Chr(13)
End If

If displaymail = False Then
  scriptToRun = scriptToRun & "send" & Chr(13)
Else
  scriptToRun = scriptToRun & "set visible to true" & Chr(13)
  scriptToRun = scriptToRun & "activate" & Chr(13)
End If

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

我想修改它,以便用户不必手动退出邮件。 感谢

0 个答案:

没有答案