Excel邮件发送Outlook

Question

我对发送消息的宏有疑问。我对 Outlook 中的签名有疑问（签名包含图像）。我尝试使用下面的代码从签名文件夹中检索特定签名。但我有一个问题，因为我还在签名中添加了一个图像，并且在运行宏后我有一个签名并代替了图像“无法显示图像”。请告诉我是否有办法解决此问题并添加带有图像的签名？

使用以下函数添加签名： 函数 AddSig(签名作为字符串)

Sub Start()
Dim FinalRowA As Integer
FinalRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To FinalRow
If Cells(i, 4).Value <> "" Then
Website = Cells(i, 4).Value
Call Mailtest(Cells(i, 4).Value)
End If
Next
End Sub


Sub Mailtest(Website)
Dim OApp As Object 'DimOutlook forEmail
Dim OMail As Object 'DimMail for Email

Set OApp = CreateObject("Outlook.Application")
Set OMail = OApp.CreateItem(0)

With OMail
.Display
Application.Wait VBA.Now + VBA.TimeValue("00:00:02")
End With


'Signature = Mid(OMail.HTMLBody, 1, Len(OMail.HTMLBody) - 13)
OMail.HTMLBody = "Auto" & Signature
OMail.To = Website
OMail.CC = "TESTTEST"
OMail.Subject = "London"
OMail.HTMLBody = "Example" & AddSig("My_Signature")

'OMail.Display 'to show mail

End Sub


Function AddSig(Signame As String)

If Len(Signame) > 0 Then
    Dim fso As Object, ts As Object
    Set fso = CreateObject("Scripting.FileSystemObject"): Set ts = fso.GetFile(Environ("Appdata") & "\Microsoft\Signatures\" & "Test_signature" & ".htm").OpenAsTextStream(1, -2)
    Signame = Replace(Signame, " ", "%20")
    AddSig = "<br>" & Replace(ts.ReadAll, _
        Signame & "_files", _
        Replace(Environ("Appdata"), " ", "%20") & "\Microsoft\Signatures\" & Signame & "_files")
End If
End Function

Answer 1

您可以在函数中读取签名来更正文件路径：

Public Function ReadSignature(sigName As String) As String 
    Dim oFSO, oTextStream, oSig As Object 
    Dim appDataDir, sig, sigPath, filename As String 
    appDataDir = Environ("APPDATA") & "\Microsoft\Signatures" 
    sigPath = appDataDir & "\" & sigName 
    Set oFSO = CreateObject("Scripting.FileSystemObject") 
    Set oTextStream = oFSO.OpenTextFile(sigPath) 
    sig = oTextStream.ReadAll 
    filename = Replace(sigName, ".htm", "") & "_files/" 
    sig = Replace(sig, filename, appDataDir & "\" & filename) 
    ReadSignature = sig 
End Function 

然后将其添加到您的邮件中：

sSignature = ReadSignature("my_signature.htm") 
sSignature = Replace(sSignature, "%20", " ") 
...
OMail.HTMLBody = "Example" &  & sSignature