|
楼主 |
发表于 2012-8-15 07:26
|
显示全部楼层
本帖最后由 civl 于 2012-8-15 07:28 编辑
- Function GetBoiler(ByVal sFile As String) As String
- '作者:Dick Kusleika
- Dim fso As Object
- Dim ts As Object
- Set fso = CreateObject("Scripting.FileSystemObject")
- Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
- GetBoiler = ts.readall
- ts.Close
- End Function
- Sub Mail_Outlook_With_Signature_Html()
- ' 别忘记在模块中加上GetBoiler函数
- ' 可以在Office 2000-2010版本中通用
- Dim OutApp As Object
- Dim OutMail As Object
- Dim strbody As String
- Dim SigString As String
- Dim Signature As String
- Set OutApp = CreateObject("Outlook.Application")
- Set OutMail = OutApp.CreateItem(0)
- strbody = "<H3><B>尊敬的XXX</B></H3>" & _
- "我是正文.<br>" & _
- "所以你看见了我,说明宏正确地运行了.<br>" & _
- "<A HREF=""http://club.excelhome.net/forum.php"">ExcelHome</A>" & _
- "<br><br><B>Regards</B>"
- '建立新邮件.htm(以html格式保存的附件),请查看自己系统中签名是什么,再替换“建立新邮件”这五个字。
- '签名保存在windows的每个用户appdata目录下的文件,每个人都不同。具体是
-
- 'Win7中Outlook的签名位置
- 'C:\用户\你的大名\AppData\Roaming\Microsoft\Signatures
-
- 'WinXP中Outlook的签名位置
- 'C:\Documents and Settings\你的大名\Application Data\Microsoft\Signatures
-
- '获取方式是使用Environ函数,并指定appdata作为需要搜索的系统文件夹
- SigString = Environ("appdata") & _
- "\Microsoft\Signatures\建立新邮件.htm"
- '但是,如果签名中有图片,必须做以下改动才能使图片不显示大叉,必须将“建立新邮件.html”文件中的图片地址改为绝对地址
- '因为Oultlook保存签名时,html文件是使用如2行引用了相对地址作为图片超链接的
- 'src = "建立新邮件_files/image001.png
- 'src = "建立新邮件_files/image001.jpg
- '你可以使用记事本打开“建立新邮件.html”,关键字为你的图片文件名称,"/"前的内容要替换为"",即绝对地址是
- 'Win7用户
- 'src = "C:\用户\你的大名\AppData\Roaming\Microsoft\Signatures\建立新邮件_files\image001.png
- 'src = "C:\用户\你的大名\AppData\Roaming\Microsoft\Signatures\建立新邮件_files\建立新邮件_files/image001.jpg
- 'WinXP用户
- 'src = "C:\Documents and Settings\你的大名\Application Data\Microsoft\Signatures\建立新邮件_files\image001.png
- 'src = "C:\Documents and Settings\你的大名\Application Data\Microsoft\Signatures\建立新邮件_files\建立新邮件_files/image001.jpg
-
- '就能正常地在签名中显示图片了
-
- '调用GetBoiler函数对Signature变量进行赋值
- If Dir(SigString) <> "" Then
- Signature = GetBoiler(SigString)
- Else
- Signature = ""
- End If
- On Error Resume Next
- With OutMail
- .To = "Test@office.com;billgates@microsoft.com" '主送
- .CC = "" '抄送
- .BCC = "" '密送
- .Subject = "我是主题" '主题
- .HTMLBody = strbody & "<br><br>" & Signature 'html格式正文
- .display '在Outlook界面显示该封待发送邮件
- '.Attachments.Add ("C:\test.txt") '附件
- '.save '保存到草稿箱
- '.send '直接发送
- End With
- On Error GoTo 0
-
- Set OutMail = Nothing
- Set OutApp = Nothing
-
- End Sub
复制代码
我做好了,能正常发送html格式的邮件,包括签名。
签名图片要自己在电脑里将相对引用改为绝对引用,才能正确显示
testEmail.rar
(17.25 KB, 下载次数: 688)
参考的代码地址:http://www.rondebruin.nl/mail/folder3/signature.htm
作者是Dick Kusleika,我作了少许翻译
|
评分
-
3
查看全部评分
-
|