堆棧內存溢出
  簡體   English   中英

如何通過Excel VBA使用Mozilla Thunderbird生成和發送電子郵件

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

 原文  2017-04-18 09:25:23  3   3    excel/ vba/ excel-vba/ email/ thunderbird

問題描述

我一直在嘗試使用VBA Macro's通過Mozilla Thunderbird通過電子表格作為附件發送電子郵件。

///我已經搜索過Google和Stack Overflow本身，但這些解決方案似乎都沒有用。////我不是最擅長編碼或擅長於自身的人，所以我只是想知道是否有任何一種靈魂可以幫助我？

感謝提供的任何幫助。

問候，

3 個解決方案

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

查看了更多文章，並嘗試按照評論所說的去做，但它們無濟於事。 但是，我設法使其中的電子郵件部分可以自己工作。 下面是我使用的代碼 

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

這打開了雷鳥中的“寫入”框，其中所有字段都已預先填寫，可以發送。

解決方案2
 1 已采納  

找到一些舊代碼。 尚未經過測試，但可與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

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

下面的代碼遍歷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

暫無
暫無

聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

相關問題 如何使用 Excel VBA 從 Thunderbird 自動發送電子郵件？ 如何使用 Excel VBA 從 Thunderbird 發送 email 主體中的圖像？ 如何使用Excel VBA發送電子郵件 通過Excel VBA代碼使用Outlook發送CDO電子郵件 使用文件夾中已保存的電子郵件模板通過excel發送帶有VBA的電子郵件？ 使用 Excel VBA 發送 Email outlook 使用 Excel VBA 發送帶有附件的 Outlook 電子郵件 Excel VBA：如何向Outlook中的組發送電子郵件？ 使用 Excel VBA 發送帶有粘貼到電子郵件正文中的過濾器范圍的電子郵件 Excel上有VBA如何發郵件給一個email上有excel信息
相關標簽
 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM