将签名添加到电子邮件的结尾
我正在尝试将Excel数据添加到Outlook电子邮件。
这是Outlook电子邮件编辑器中输出的图示。 我试图添加的img应该在Excel内容后面添加。
我尝试了各种方法来添加一个脚注的图像。
我试着添加<img>
标签来附加它作为HTML附件,但它没有任何间距的连接。
试着最初使用这两行
.Attachments.Add "C:\Users\Sumit Jain\Pictures\11\city.jpg", olByValue, 0 .HTMLBody = .HTMLBody & "<img src='cid:city.jpg'><br>"
然后我尝试在Outlook中进行默认签名。
代码
.HTMLBody = "<HTML><body><body></HTML>" & .HTMLBody
将Outlook的默认签名添加到顶部,然后添加Excel内容。
参考页面我使用了Link的逻辑
下面是代码
Private Sub CommandButton9_Click() On Error GoTo ERRORMSG Dim OutApp As Object Dim OutMail As Object Dim olInsp As Object Dim wdDoc As Object Dim oRng As Object Set otlApp = CreateObject("Outlook.Application") Set olMail = otlApp.CreateItem(olMailItem) Set Doc = olMail.GetInspector.WordEditor Set mainWB = ActiveWorkbook mainWB.Sheets("Mail").Range("m8").Value = ComboBox4.Value mainWB.Sheets("Mail").Range("n8").Value = TextBox40.Value mainWB.Sheets("Mail").Range("q8").Value = ComboBox5.Value mainWB.Sheets("Mail").Range("r8").Value = ComboBox6.Value mainWB.Sheets("Mail").Range("s8").Value = ComboBox7.Value mainWB.Sheets("Mail").Range("t8").Value = TextBox44.Value On Error Resume Next Set OutApp = GetObject(, "Outlook.Application") If Err <> 0 Then Set OutApp = CreateObject("Outlook.Application") On Error GoTo 0 Set OutMail = OutApp.CreateItem(0) With OutMail .To = mainWB.Sheets("Email").Range("A3").Value .cc = mainWB.Sheets("Mail").Range("L12").Value .Subject = mainWB.Sheets("Mail").Range("O15").Value Set olInsp = .GetInspector Set wdDoc = olInsp.WordEditor Set oRng = wdDoc.Range 'force html format .HTMLBody = "<HTML><body><body></HTML>" & .HTMLBody .Display '--- start with 6 CrLf's, so we can place each table ' above all but the last used... oRng.InsertAfter vbCrLf & vbCrLf '--- now reselect the entire document, collapse our cursor to the end ' and back up one character (so that the table inserts before the SIXTH CrLf) Set oRng = wdDoc.Range oRng.collapse 0 oRng.Move 1, -1 Range("K3:T10").Select Selection.Copy oRng.Paste '--- finally move the cursor all the way to the end and paste the ' second table BELOW the SIXTH CrLf Set oRng = wdDoc.Range oRng.collapse 0 Range("K38:T46").Select Selection.Copy oRng.Paste End With Exit Sub End Sub
在你的代码中尝试以下内容….
您需要将Mysig.htm
添加到签名的名称
SigString = Environ("appdata") & "\Microsoft\Signatures\" & UOutLookSign & ".htm" If Dir(SigString) <> "" Then Signature = GetBoiler(SigString) Else Signature = "" End If