如何通过Excel VBA使用Mozilla Thunderbird生成和发送电子邮件

Question

I've been looking into trying to use VBA Macro's to send an email through Mozilla Thunderbird with the spreadsheet as an attachment. 我一直在尝试使用VBA Macro's通过Mozilla Thunderbird通过电子表格作为附件发送电子邮件。

///I've searched Google and Stack Overflow itself and none of those solutions seem to be working./// I am not the best at coding or excel itself so I was just wondering if any kind soul could help me out? ///我已经搜索过Google和Stack Overflow本身，但这些解决方案似乎都没有用。////我不是最擅长编码或擅长于自身的人，所以我只是想知道是否有任何一种灵魂可以帮助我？

Appreciate any help given. 感谢提供的任何帮助。

Regards, 问候，

Answer 1

Looked at a load more articles and tried following what the comments have said but they didn't help. 查看了更多文章，并尝试按照评论所说的去做，但它们无济于事。 I have, however, managed to get the email portion of this to work myself. 但是，我设法使其中的电子邮件部分可以自己工作。 Below is the code I use 下面是我使用的代码

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

This opened the 'Write' box in thunderbird with all the fields pre-filled out ready to send. 这打开了雷鸟中的“写入”框，其中所有字段都已预先填写，可以发送。

Answer 2

Found some old code. 找到一些旧代码。 Not recently tested but it worked with attachments for Thunderbird. 尚未经过测试，但可与Thunderbird的附件一起使用。 You probably have to adapt it to your needs: 您可能必须使其适应您的需求：

'***********************************************************************
'* 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

Answer 3

The code below iterates through a range in excel and for each record marked for sending it will send an email using Thunderbird. 下面的代码遍历excel中的一个范围，对于标记为发送的每个记录，将使用Thunderbird发送电子邮件。 Additionally, if the path to a file is specified it will attach that file. 此外，如果指定了文件的路径，它将附加该文件。 Be careful with the apostrophes when building the command string. 构建命令字符串时，请小心撇号。 If you get them wrong the non-printing characters will be removed from the message body for some reason. 如果您弄错了它们，则出于某些原因，非打印字符将从消息正文中删除。

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

如何通过Excel VBA使用Mozilla Thunderbird生成和发送电子邮件

问题描述

3 个解决方案

解决方案1
2 2017-04-18 13:25:46

解决方案2
1 已采纳

解决方案3
1 2017-11-12 21:49:33

如何通过Excel VBA使用Mozilla Thunderbird生成和发送电子邮件

问题描述

3 个解决方案

解决方案1 2 2017-04-18 13:25:46

解决方案2 1 已采纳

解决方案3 1 2017-11-12 21:49:33

解决方案1
2 2017-04-18 13:25:46

解决方案2
1 已采纳

解决方案3
1 2017-11-12 21:49:33