如何使用Mozilla Thunderbird通过Excel VBA生成和发送电子邮件
我一直在试图使用VBAmacros的电子表格作为附件通过Mozilla Thunderbird发送电子邮件。
///我已经search了Google和Stack Overflow本身，这些解决scheme似乎都没有工作。///我不是最好的编码或擅长本身，所以我只是想知道有没有什么灵魂可以帮助我？
感谢任何帮助。
问候，
发现了一些旧的代码。 最近没有testing过，但它与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 看着一个加载更多的文章，并尝试按照评论的说法，但他们没有帮助。 不过，我已经设法让自己的电子邮件部分工作。 以下是我使用的代码
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
这打开了雷鸟的“写”框，所有的字段都预先填好了，准备发送。
下面的代码在excel中遍历一个范围，每个标记为发送的logging都将使用Thunderbird发送一封邮件。 另外，如果指定了文件的path，它将附加该文件。 构build命令string时要小心撇号。 如果你弄错了，出于某种原因，非打印字符将从邮件正文中删除。
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