Question

我一直在尝试使用VBA Macro来通过电子表格作为附件通过Mozilla Thunderbird发送电子邮件。

///我搜索了Google和Stack Overflow本身，这些解决方案似乎都没有工作./// 我不是最好的编码或擅长自我，所以我只是想知道是否有任何善良的灵魂可以帮助我？

感谢给予的任何帮助。

此致

Answer 1

看了很多文章并尝试按照评论所说的但他们没有帮助。但是，我设法让自己的电子邮件部分工作。以下是我使用的代码

 LEFT JOIN (select * from dbo.Synonym  where @three IS NOT NULL) as synm ON cinfo.ID = synm.ID

这打开了'写'＆＃39;雷鸟的盒子，所有的田地都预先准备好发送。

Answer 2

找到一些旧代码。最近没有测试，但它与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

Answer 3

下面的代码遍历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

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

3 个答案: