stackoom
  简体   繁体   中英

How to generate and send an email using Mozilla Thunderbird through Excel VBA

 原文  2017-04-18 09:25:23  1   3    excel/ vba/ excel-vba/ email/ 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.

///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?

Appreciate any help given.

Regards,

3 answers

solution1
 2  2017-04-18 13:25:46

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.

solution2
 1 ACCPTED  

Found some old code. Not recently tested but it worked with attachments for 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

solution3
 1  2017-11-12 21:49:33

The code below iterates through a range in excel and for each record marked for sending it will send an email using 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

暂无
暂无

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

Related Question How can I automatically send email from Thunderbird with Excel VBA? How can I send an image in the email body from Thunderbird with Excel VBA? How to send email using excel VBA Send CDO email using Outlook through excel VBA code Send email with VBA through excel with already saved email template in folder? Send Email outlook using Excel VBA Send Outlook email with attachment using Excel VBA Excel VBA: How to send email to group in outlook? Send Email With A Filter Range Pasted Into Email Body using Excel VBA On Excel with VBA how to send an mail to one email with excel information in it
Related Tags
 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM