在 Windows 和 Mac 上发送带有来自 VBA 宏的工作簿的电子邮件
Send email with workbook from VBA macro on both Windows and Mac
我的以下代码在 PC 上运行正常,但在 Mac 上运行不正常。我希望脚本能够识别当前的 OS 和 运行 适当的命令集,而不是为 Windows 和 Mac 用户制作带有单独按钮的两个版本的宏为此 OS。
该宏会创建一封带有工作簿附件的电子邮件。附件是 ActiveWorkbook 的临时版本,在发送电子邮件后将被删除。
我目前使用的发送电子邮件的方法是 Windows CDO。在使用 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
所以要确定 OS,您可以像这样使用 conditional compilation directives:
#If Mac Then
Debug.Print "I'm a Mac"
#Else
Debug.Print "I'm not"
#End If
由于 OS 内置的安全性,在现代 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
我的以下代码在 PC 上运行正常,但在 Mac 上运行不正常。我希望脚本能够识别当前的 OS 和 运行 适当的命令集,而不是为 Windows 和 Mac 用户制作带有单独按钮的两个版本的宏为此 OS。
该宏会创建一封带有工作簿附件的电子邮件。附件是 ActiveWorkbook 的临时版本,在发送电子邮件后将被删除。
我目前使用的发送电子邮件的方法是 Windows CDO。在使用 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
所以要确定 OS,您可以像这样使用 conditional compilation directives:
#If Mac Then
Debug.Print "I'm a Mac"
#Else
Debug.Print "I'm not"
#End If
由于 OS 内置的安全性,在现代 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