目标是针对生成电子邮件按钮的任何人，它在其中添加了自己的个人Outlook签名，其中包括公司徽标以及可能的GIF。我已经尝试过各种方法来修复它，但是它最终会彻底破坏或弄乱电子邮件。这是我必须实现目标的关闭。 例如，代码是：
Sub send_email_with_table_as_Pic_1()
Dim outapp As Object
Dim outmail As Object
Dim table As Range
Dim ws As Worksheet
Dim pic As Object
Dim worddoc As Object
Dim imgShape As Object
Dim currentDate As String
Dim generatedTime As String
Dim FSO As Object
Dim SigFile As Object
Dim Signature As String
Dim sigPath As String
Dim enviro As String
' Capture the current date
currentDate = Format(Date, "mm/dd/yyyy")
' Capture the current time in "hh:mm AM/PM CST" format
generatedTime = GetCSTTime()
' Create Outlook application
Set outapp = CreateObject("Outlook.Application")
Set outmail = outapp.CreateItem(0)
' Get the sender's signature path
enviro = Environ("appdata") ' Fetch user AppData path
sigPath = enviro & "\Microsoft\Signatures\"
' Check for HTML signature
If Dir(sigPath, vbDirectory) <> "" Then
If Dir(sigPath & "*.htm") <> "" Then
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SigFile = FSO.OpenTextFile(sigPath & Dir(sigPath & "*.htm"), 1)
Signature = SigFile.ReadAll
SigFile.Close
Else
Signature = "" ' No signature found
End If
Else
Signature = ""
End If
' Set reference to the worksheet and range
Set ws = ThisWorkbook.Sheets("Metrics")
Set table = ws.Range("C2:U64")
' Copy the table as a picture
table.CopyPicture xlScreen, xlPicture
' Create the email
With outmail
.SentOnBehalfOfName = "[email protected]"
.To = "[email protected]; [email protected]"
.Subject = "Mid-Day Performance Metrics Report " & currentDate
.Display
' Add the image to the email body via Word Editor
Set worddoc = outmail.GetInspector.WordEditor
worddoc.Range.Paste
' Adjust the image size
Set imgShape = worddoc.InlineShapes(worddoc.InlineShapes.Count)
imgShape.LockAspectRatio = False
imgShape.Height = 12.5 * 72
imgShape.Width = 18 * 72
' Add text after the image
With worddoc.Range
.InsertParagraphAfter
.InsertParagraphAfter
.InsertAfter "Please let us know if you have any questions or concerns."
.InsertParagraphAfter
.InsertParagraphAfter
.InsertAfter "Thank you,"
End With
' Add HTML body content and append the sender's signature
.htmlBody = "<body style='font-size:11pt; font-family:Calibri'>" & _
"Good Afternoon,<p> Below is the Performance Mid-Day report as of <b>" & generatedTime & "</b>.</p><br>" & _
.htmlBody & _
"<br><br>" & Signature ' Append signature at the end
End With
' Clean up
Set outapp = Nothing
Set outmail = Nothing
Set pic = Nothing
Set FSO = Nothing
Set SigFile = Nothing
End Sub
获得默认签名的方法是创建一封新电子邮件，并将其存储在临时变量中检查此线程以获取更多信息：