作者:乔山办公网日期:
返回目录:excel表格制作
参考下面的VBA代码
Sub Send_Email()
Dim i As Integer
Dim MyOutlookApp As Outlook.Application
Dim MyFolder As Outlook.MAPIFolder
Dim MyNewMail As Outlook.MailItem
Dim MyAttachments As Outlook.Attachments '附件
Set MyOutlookApp = New Outlook.Application
Set MyFolder = MyOutlookApp.GetNamespace( "MAPI ").GetDefaultFolder(olFolderInbox).Folders( "我的邮件7a64e59b9ee7ad94336文件夹 ")
Set MyNewMail = MyOutlookApp.CreateItem(olMailItem)
With MyNewMail
.To = " " '目标邮件地址
.Cc=""
.Subject = "test " '标题
.HTMLBody = " <p> <b> This </b> is <font color= '#ff000 '> red </font> </p> "
.AlternateRecipientAllowed = True '此邮件可转发
.AutoForwarded = True '此邮件允许自动转发
.DeleteAfterSubmit = False '发送后保留副本
'发送之后移动到指定文件夹
.SaveSentMessageFolder = MyOutlookApp.GetNamespace( "MAPI ").GetDefaultFolder(olFolderInbox).Folders( "备份文件夹 ")
.ReadReceiptRequested = True '要求收件人回执
'SaveSentMessageFolder
End With
'附件
Set MyAttachments = MyNewMail.Attachments
MyAttachments.Add "c:\win\abc.txt ", olByValue
MyNewMail.Save '保存
MyNewMail.Send '发送
MyFolder.Display '显示office outlook
End Sub
可以直接使用API函数ShellExecute
复制下面的代码,直接粘贴到你的代码模7a686964616fe59b9ee7ad94363块中,然后运行EmailSend即可看到效果。
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub EmailSend()
Dim receiver$, MyMail$, MySubject$
receiver = ""
MySubject = "试试看"
MyMail = "mailto:" & receiver & "?subject=" & MySubject & "&body=Linie:这是一个测试"
ShellExecute 0&, vbNullString, MyMail, vbNullString, vbNullString, 1
End Sub
用word的邮件合并功能就可以方便的实现,工具》信函与邮件》邮件合并,按照向导一步步就做出来了,简单!
以前研究过类似的,好像Outlook有防病毒保护,不允许直抄接由Vba发送邮件,会出现提示框的。百只有人为按确认键后才能发送。所以我当时是用宏自动生成草稿,最后由人工统一发送。
当初也找到过第三度方软件来解决这个问题,但现在忘了名称了。