如何通过 Excel VBA 使用 Mozilla Thunderbird 生成和发送电子邮件
How to generate and send an email using Mozilla Thunderbird through Excel VBA
我一直在尝试使用 VBA 宏通过 Mozilla Thunderbird 发送电子邮件，并将电子表格作为附件。
///我搜索了 Google 和 Stack Overflow 本身，none 这些解决方案似乎有效。/// 我不是最擅长编码或 excel 本身所以我只是想知道是否有好心人可以帮助我？
感谢您提供的任何帮助。
此致，
查看了更多文章并尝试按照评论所说的进行操作，但没有帮助。但是，我已经设法让其中的电子邮件部分自己工作。下面是我使用的代码
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As
String, _
ByVal nShowCmd As Long) As Long
Sub Send_Email_Using_Keys()
Dim Mail_Object As String
Dim Email_Subject, Email_Send_To, Email_Cc, Email_Bcc, Email_Body As String
Email_Subject = "ACT Form Completed and Confirmed"
Email_Send_To = "kieranfarley@achievementtraining.com"
Email_Cc = "kieranfarley@achievementtraining.com"
Email_Bcc = "kieranfarley@achievementtraining.com"
Email_Body = "ACT Form Completed and Confirmed Please see attached"
Mail_Object = "mailto:" & Email_Send_To & "?subject=" & Email_Subject &
"&body=" & Email_Body & "&cc=" & Email_Cc & "&bcc=" & Email_Bcc
On Error GoTo debugs
ShellExecute 0&, vbNullString, Mail_Object, vbNullString, vbNullString,
vbNormalFocus
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub
这会在 thunderbird 中打开 'Write' 框，所有字段都已预先填写好，可以发送了。
找到一些旧代码。最近没有测试，但它适用于 Thunderbird 的附件。您可能必须根据自己的需要调整它：
'***********************************************************************
'* Send mail with Thunderbird
'*
Option Explicit
'***********************
'* HTML formatting
'*
Private Const STARTBODY = "<html><head><style type='text/css'> body { font: 11pt Calibri, Verdana, Geneva, Arial, Helvetica, sans-serif; } </style></head><body> "
Private Const ENDBODY = "</body></htlm>"
'* Test only
Private Const ATTACHMENT1 = "C:\Temp\attachment1.pdf"
Private Const ATTACHMENT2 = "C:\Temp\attachment2.pdf"
'*******************************************************************************************
'* Test code only. Can be run by placing the cursor anywhere within the code and press F5
'* SetX THUNDERBIRD_PATH "C:\Program Files\Mozilla Thunderbird\thunderbird.exe"
'*
Private Sub MailTest()
Dim Rcp As String
Dim CC As String
Dim BCC As String
Dim Result As Boolean
Rcp = "someone@domain.com"
CC = "someoneelse@domain.com"
BCC = "onedude@domain.com"
Result = SendMail(Rcp, CC, BCC, "Test", "Hello World", False, ATTACHMENT1 & ";" & ATTACHMENT2)
End Sub
'****************************************************************************
'* Send e-mail through Thunderbird
'* SetX THUNDERBIRD_PATH "C:\Program Files\Mozilla Thunderbird\thunderbird.exe"
'*
Function SendMail(strTo As String, _
strCC As String, _
strBCC As String, _
strSubject As String, _
strMessageBody As String, _
Optional PlainTextFormat As Boolean = False, _
Optional strAttachments As String = "", _
Optional SignatureFile As String = "") As Boolean
Dim Cmd As String
Dim Arg As String
Dim Result As Integer
Dim objOutlook As Outlook.Application
Dim MAPISession As Outlook.NameSpace
Dim MAPIMailItem As Outlook.MailItem
Dim strTemp As String
Dim MailResult As Boolean
Dim I As Integer
Dim Account As Object
MailResult = False
Cmd = Environ("THUNDERBIRD_PATH") 'E:\Program Files\Mozilla Thunderbird\thunderbird.exe
If Cmd <> "" Then ' Thunderbird installed
Arg = " -compose """
strTo = Replace(strTo, ";", ",")
If strTo <> "" Then Arg = Arg & "to='" & strTo & "',"
strCC = Replace(strCC, ";", ",")
If strCC <> "" Then Arg = Arg & "cc='" & strCC & "',"
strBCC = Replace(strBCC, ";", ",")
If strBCC <> "" Then Arg = Arg & "bcc='" & strBCC & "',"
If strSubject <> "" Then Arg = Arg & "subject=" & strSubject & ","
If PlainTextFormat = True Then
strTemp = "2" 'Plain text
Else
strTemp = "1" 'HTML
strMessageBody = STARTBODY & strMessageBody & ENDBODY 'Add HTML and CSS
End If
Arg = Arg & "format=" & strTemp & "," 'Format specifier HTML or Plain Text
Arg = Arg & "body='" & strMessageBody & "'," 'Add body text
Call AddSignature(SignatureFile, strMessageBody) 'Add signature if any
Arg = Arg & "attachment='"
Call AddAttachments(strAttachments, , Arg) 'Add attachment(s) if any
Arg = Arg & "'""" 'Closing quotes
Shell Cmd & Arg 'Call Thunderbird to send the message
MailResult = True
SendMail = MailResult
End Function
'*******************************************************************
'* Add recipients, CC or BCC recipients to the email message
'* Recipients is a string with one or more email addresses,
'* each separated with a semicolon
'* Returns number of addresses added
'*
Private Function AddRecipients(Recipients As String, MAPIMailItem As Outlook.MailItem, RecType As Integer) As Integer
Dim OLRecipient As Outlook.Recipient
Dim TempArray() As String
Dim Recipient As Variant
Dim Emailaddr As String
Dim Count As Integer
Count = 0
TempArray = Split(Recipients, ";")
For Each Recipient In TempArray
Emailaddr = Trim(Recipient)
If Emailaddr <> "" Then
Set OLRecipient = MAPIMailItem.Recipients.Add(Emailaddr)
OLRecipient.Type = RecType
Set OLRecipient = Nothing
Count = Count + 1
End If
Next Recipient
AddRecipients = Count
End Function
'******************************************************
'* Add possible signature to the email message
'* Returns True if signature added
'*
Private Function AddSignature(SignatureFile As String, ByRef strMessageBody As String) As Boolean
Dim Signature As String
Dim Tempstr As String
Dim Added As Boolean
Added = False
If SignatureFile <> "" Then
Signature = ""
Open SignatureFile For Input As #1 'Open file for reading
Do While Not EOF(1) 'Loop through file
Input #1, Tempstr 'One line
Signature = Signature & Tempstr 'Add it
Loop
Close #1
strMessageBody = strMessageBody & Signature 'Add to message
Added = True
End If
AddSignature = Added
End Function
'******************************************************
'* Add possible attachments to the email message
'* Returns number of attachments added
'*
Private Function AddAttachments(ByRef strAttachments As String) As Integer
Dim TempArray() As String
Dim Attachment As Variant
Dim Tempstr As String
Dim Count As Integer
Count = 0
TempArray = Split(strAttachments, ";")
For Each Attachment In TempArray
Tempstr = CStr(Trim(Attachment))
If Tempstr <> "" Then
If Count > 0 Then Arg = Arg & ","
Arg = Arg & "file:///" & Tempstr
End If
Count = Count + 1
Next Attachment
AddAttachments = Count
End Function
下面的代码遍历 excel 中的一个范围，对于标记为发送的每条记录，它将使用 Thunderbird 发送一封电子邮件。此外，如果指定了文件路径，它将附加该文件。构建命令字符串时要小心撇号。如果你弄错了，非打印字符将出于某种原因从邮件正文中删除。
Public Sub sendEmail(subject As String, msg As String, path As String)
Dim contactRange As Range, cell As Range
Dim count As Integer
Dim thund As String
Dim email As String
Dim recipientName As String
Dim pathToThunderBird
Set contactRange = Range("ContactYesNo")
pathToThunderBird = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe "
With Worksheets("IT consulting")
For Each cell In contactRange
If cell.Value = "Yes" Then
count = count + 1
recipientName = cell.Offset(0, 2).Value
email = cell.Offset(0, 6).Value
emailMsg = "Hi " & recipientName & vbCrLf & vbCrLf & msg & vbCrLf
'You'll want to change the salutation.
thund = pathToThunderBird & _
"-compose " & """" & _
"to='" & email & "'," & _
",subject='" & subject & "'," & _
",body='" & emailMsg & vbCrLf & vbCrLf & _
"Your Name" & vbCrLf & _
"123.456.7890" & "'" & """"
If path = "" Then 'no attachment
'do nothing
Else 'with attachment
thund = thund & ",attachment=" & path
End If
Call Shell(thund, vbNormalFocus)
'comment this out if you do not want to send automatically
SendKeys "^+{ENTER}", True
End If
Next cell
End With
End Sub
我一直在尝试使用 VBA 宏通过 Mozilla Thunderbird 发送电子邮件，并将电子表格作为附件。
///我搜索了 Google 和 Stack Overflow 本身，none 这些解决方案似乎有效。/// 我不是最擅长编码或 excel 本身所以我只是想知道是否有好心人可以帮助我？
感谢您提供的任何帮助。
此致，
查看了更多文章并尝试按照评论所说的进行操作，但没有帮助。但是，我已经设法让其中的电子邮件部分自己工作。下面是我使用的代码
Private Declare Function ShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As
String, _
ByVal nShowCmd As Long) As Long
Sub Send_Email_Using_Keys()
Dim Mail_Object As String
Dim Email_Subject, Email_Send_To, Email_Cc, Email_Bcc, Email_Body As String
Email_Subject = "ACT Form Completed and Confirmed"
Email_Send_To = "kieranfarley@achievementtraining.com"
Email_Cc = "kieranfarley@achievementtraining.com"
Email_Bcc = "kieranfarley@achievementtraining.com"
Email_Body = "ACT Form Completed and Confirmed Please see attached"
Mail_Object = "mailto:" & Email_Send_To & "?subject=" & Email_Subject &
"&body=" & Email_Body & "&cc=" & Email_Cc & "&bcc=" & Email_Bcc
On Error GoTo debugs
ShellExecute 0&, vbNullString, Mail_Object, vbNullString, vbNullString,
vbNormalFocus
Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%s"
debugs:
If Err.Description <> "" Then MsgBox Err.Description
End Sub
这会在 thunderbird 中打开 'Write' 框，所有字段都已预先填写好，可以发送了。
找到一些旧代码。最近没有测试，但它适用于 Thunderbird 的附件。您可能必须根据自己的需要调整它：
'***********************************************************************
'* Send mail with Thunderbird
'*
Option Explicit
'***********************
'* HTML formatting
'*
Private Const STARTBODY = "<html><head><style type='text/css'> body { font: 11pt Calibri, Verdana, Geneva, Arial, Helvetica, sans-serif; } </style></head><body> "
Private Const ENDBODY = "</body></htlm>"
'* Test only
Private Const ATTACHMENT1 = "C:\Temp\attachment1.pdf"
Private Const ATTACHMENT2 = "C:\Temp\attachment2.pdf"
'*******************************************************************************************
'* Test code only. Can be run by placing the cursor anywhere within the code and press F5
'* SetX THUNDERBIRD_PATH "C:\Program Files\Mozilla Thunderbird\thunderbird.exe"
'*
Private Sub MailTest()
Dim Rcp As String
Dim CC As String
Dim BCC As String
Dim Result As Boolean
Rcp = "someone@domain.com"
CC = "someoneelse@domain.com"
BCC = "onedude@domain.com"
Result = SendMail(Rcp, CC, BCC, "Test", "Hello World", False, ATTACHMENT1 & ";" & ATTACHMENT2)
End Sub
'****************************************************************************
'* Send e-mail through Thunderbird
'* SetX THUNDERBIRD_PATH "C:\Program Files\Mozilla Thunderbird\thunderbird.exe"
'*
Function SendMail(strTo As String, _
strCC As String, _
strBCC As String, _
strSubject As String, _
strMessageBody As String, _
Optional PlainTextFormat As Boolean = False, _
Optional strAttachments As String = "", _
Optional SignatureFile As String = "") As Boolean
Dim Cmd As String
Dim Arg As String
Dim Result As Integer
Dim objOutlook As Outlook.Application
Dim MAPISession As Outlook.NameSpace
Dim MAPIMailItem As Outlook.MailItem
Dim strTemp As String
Dim MailResult As Boolean
Dim I As Integer
Dim Account As Object
MailResult = False
Cmd = Environ("THUNDERBIRD_PATH") 'E:\Program Files\Mozilla Thunderbird\thunderbird.exe
If Cmd <> "" Then ' Thunderbird installed
Arg = " -compose """
strTo = Replace(strTo, ";", ",")
If strTo <> "" Then Arg = Arg & "to='" & strTo & "',"
strCC = Replace(strCC, ";", ",")
If strCC <> "" Then Arg = Arg & "cc='" & strCC & "',"
strBCC = Replace(strBCC, ";", ",")
If strBCC <> "" Then Arg = Arg & "bcc='" & strBCC & "',"
If strSubject <> "" Then Arg = Arg & "subject=" & strSubject & ","
If PlainTextFormat = True Then
strTemp = "2" 'Plain text
Else
strTemp = "1" 'HTML
strMessageBody = STARTBODY & strMessageBody & ENDBODY 'Add HTML and CSS
End If
Arg = Arg & "format=" & strTemp & "," 'Format specifier HTML or Plain Text
Arg = Arg & "body='" & strMessageBody & "'," 'Add body text
Call AddSignature(SignatureFile, strMessageBody) 'Add signature if any
Arg = Arg & "attachment='"
Call AddAttachments(strAttachments, , Arg) 'Add attachment(s) if any
Arg = Arg & "'""" 'Closing quotes
Shell Cmd & Arg 'Call Thunderbird to send the message
MailResult = True
SendMail = MailResult
End Function
'*******************************************************************
'* Add recipients, CC or BCC recipients to the email message
'* Recipients is a string with one or more email addresses,
'* each separated with a semicolon
'* Returns number of addresses added
'*
Private Function AddRecipients(Recipients As String, MAPIMailItem As Outlook.MailItem, RecType As Integer) As Integer
Dim OLRecipient As Outlook.Recipient
Dim TempArray() As String
Dim Recipient As Variant
Dim Emailaddr As String
Dim Count As Integer
Count = 0
TempArray = Split(Recipients, ";")
For Each Recipient In TempArray
Emailaddr = Trim(Recipient)
If Emailaddr <> "" Then
Set OLRecipient = MAPIMailItem.Recipients.Add(Emailaddr)
OLRecipient.Type = RecType
Set OLRecipient = Nothing
Count = Count + 1
End If
Next Recipient
AddRecipients = Count
End Function
'******************************************************
'* Add possible signature to the email message
'* Returns True if signature added
'*
Private Function AddSignature(SignatureFile As String, ByRef strMessageBody As String) As Boolean
Dim Signature As String
Dim Tempstr As String
Dim Added As Boolean
Added = False
If SignatureFile <> "" Then
Signature = ""
Open SignatureFile For Input As #1 'Open file for reading
Do While Not EOF(1) 'Loop through file
Input #1, Tempstr 'One line
Signature = Signature & Tempstr 'Add it
Loop
Close #1
strMessageBody = strMessageBody & Signature 'Add to message
Added = True
End If
AddSignature = Added
End Function
'******************************************************
'* Add possible attachments to the email message
'* Returns number of attachments added
'*
Private Function AddAttachments(ByRef strAttachments As String) As Integer
Dim TempArray() As String
Dim Attachment As Variant
Dim Tempstr As String
Dim Count As Integer
Count = 0
TempArray = Split(strAttachments, ";")
For Each Attachment In TempArray
Tempstr = CStr(Trim(Attachment))
If Tempstr <> "" Then
If Count > 0 Then Arg = Arg & ","
Arg = Arg & "file:///" & Tempstr
End If
Count = Count + 1
Next Attachment
AddAttachments = Count
End Function
下面的代码遍历 excel 中的一个范围，对于标记为发送的每条记录，它将使用 Thunderbird 发送一封电子邮件。此外，如果指定了文件路径，它将附加该文件。构建命令字符串时要小心撇号。如果你弄错了，非打印字符将出于某种原因从邮件正文中删除。
Public Sub sendEmail(subject As String, msg As String, path As String)
Dim contactRange As Range, cell As Range
Dim count As Integer
Dim thund As String
Dim email As String
Dim recipientName As String
Dim pathToThunderBird
Set contactRange = Range("ContactYesNo")
pathToThunderBird = "C:\Program Files (x86)\Mozilla Thunderbird\thunderbird.exe "
With Worksheets("IT consulting")
For Each cell In contactRange
If cell.Value = "Yes" Then
count = count + 1
recipientName = cell.Offset(0, 2).Value
email = cell.Offset(0, 6).Value
emailMsg = "Hi " & recipientName & vbCrLf & vbCrLf & msg & vbCrLf
'You'll want to change the salutation.
thund = pathToThunderBird & _
"-compose " & """" & _
"to='" & email & "'," & _
",subject='" & subject & "'," & _
",body='" & emailMsg & vbCrLf & vbCrLf & _
"Your Name" & vbCrLf & _
"123.456.7890" & "'" & """"
If path = "" Then 'no attachment
'do nothing
Else 'with attachment
thund = thund & ",attachment=" & path
End If
Call Shell(thund, vbNormalFocus)
'comment this out if you do not want to send automatically
SendKeys "^+{ENTER}", True
End If
Next cell
End With
End Sub