Question

下面的代码由HK1发布，以回应7月20日发布的VBA中没有Outlook的电子邮件的答案。

代码运行良好，但我需要在文本末尾添加一个签名块（基本上是本地文件夹中的jpg文件），但我能想到的最好的是添加路径（文本）而不是图像本身到电子邮件正文。

Const cdoSendUsingPickup = 1
Const cdoSendUsingPort = 2
Const cdoAnonymous = 0
' Use basic (clear-text) authentication.
Const cdoBasic = 1
' Use NTLM authentication
Const cdoNTLM = 2 'NTLM

Public Sub SendEmail()
 Dim imsg As Object
 Dim iconf As Object
 Dim flds As Object
 Dim schema As String

 Set imsg = CreateObject("CDO.Message")
  Set iconf = CreateObject("CDO.Configuration")
Set flds = iconf.Fields

' send one copy with SMTP server (with autentication)
schema = "http://schemas.microsoft.com/cdo/configuration/"
flds.Item(schema & "sendusing") = cdoSendUsingPort
flds.Item(schema & "smtpserver") = "mail.myserver.com"
flds.Item(schema & "smtpserverport") = 25
flds.Item(schema & "smtpauthenticate") = cdoBasic
flds.Item(schema & "sendusername") = "email@email.com"
flds.Item(schema & "sendpassword") = "password"
flds.Item(schema & "smtpusessl") = False
flds.Update

With imsg
    .To = "email@email.com"
    .From = "email@email.com"
    .Subject = "Test Send"
    .HTMLBody = "Test"
    '.Sender = "Sender"
    '.Organization = "My Company"
    '.ReplyTo = "address@mycompany.com"
    Set .Configuration = iconf
    .Send
End With

   Set iconf = Nothing
   Set imsg = Nothing
   Set flds = Nothing
End Sub

我尝试按如下方式修改代码，但这只是将文件路径添加到正文文本中：

With imsg
  .To = vRecipients
  .From = senderEmail
  .CC = vCC
  .Subject = vSubject

  vBody = Replace(vBody, vbCrLf, "<br>")
  vBody = "<FONT face=arial size=2>" & vBody

  vBody = vBody & "<br>" & signFile
  .HTMLBody = vBody

  .Sender = senderName
  .ReplyTo = senderEmail
  .AddAttachment vAttachments

  Set .Configuration = iconf
  .Send
End With

有什么建议吗？

Answer 1

dwo是对的。您需要使用文件系统对象或文件对象来读取signFile的文本内容。否则你的代码看起来应该可以工作。

这是一个可用于读取文件内容的函数。该函数假定您将传入应用程序至少具有读取权限的文本文件的整个路径和文件名。

Public Function GetTextFileContents(sFilePath as String) As String
    If Dir(sFilePath) <> "" Then
        Dim fso As Object
        Dim ts As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set ts = fso.GetFile(sFilePath).OpenAsTextStream(1, -2)
        GetTextFileContents = ts.ReadAll
        ts.Close
        Set ts = Nothing
        Set fso = Nothing
    End If
End Function

Answer 2

您是否尝试过现成的解决方案？我过去曾使用过exclaimer和emailsignanture.com。我认为电子邮件签名如何通过您讨论的jpeg挑战是图像以HTML降价方式完成，类似于：

（/路径/到/ img.jpg）

（/ path / to / img.jpg“可选标题”）

用于处理不同渲染代理的大小调整。

在中包含电子邮件签名

2 个答案: