outlook 用宏发邮件

经常发面试邮件，通常只是修改一下收件人邮箱地址，和收件人姓名，其他全部一致，有木有发现每次都用用outlook写邮件很麻烦？

使用宏发邮件，就会不麻烦了，直接修改下称呼，修改下收件人地址，按下F5，就可以直接发送了。

Private Sub send_mail()

'新建邮件

Set OutApp = CreateObject("Outlook.Application") '创建outlook对象

OutApp.Session.Logon '登录MAPI
Set outmail = OutApp.CreateItem(olMailItem) '新建邮件对象

Dim strTo, strCC, strSubject, strName
strTo = "aaa@bbb.com.cn"
strCC = "aaa@bbb.com.cn"
strName = "面试人"
strSubject = "我公司面试邀请-" & strName

If strName = "" Then
MsgBox "收件人名称不能为空哦"
Exit Sub
End If

If MsgBox("确认要发送邮件?" & vbCrLf & "title:" & strSubject & vbCrLf & "to:" & strTo & vbCrLf & "cc:" & strCC, vbYesNo) = vbNo Then
Exit Sub
End If

strContent = strName & ",您好," & vbCrLf
strContent = strContent & " 很高兴邀请您参加我司Java工程师面试!" & vbCrLf 
strContent = strContent & " 地点: XXX" & vbCrLf
strContent = strContent & " 乘车路线：XXX" & vbCrLf
strContent = strContent & " 请注意：XX。" & vbCrLf

strContent = strContent & " 到达后请联系:" & vbCrLf
strContent = strContent & " AAA：010 ######## 分机：" & vbCrLf
strContent = strContent & " CBD：133CXXXXXX" & vbCrLf

strContent = strContent & "如有变化，请提前告知，谢谢！" & vbCrLf & vbCrLf

'签名信息
strContent = strContent & "________________________________________" & vbCrLf
strContent = strContent & "Best regards!" & vbCrLf

strContent = strContent & "XXXX" & vbCrLf

'设置邮件标题、收件人、等等

With outmail
.To = strTo '收件人

.CC = strCC '抄送
.BCC = ""
.Subject = strSubject '主题
.Body = strContent
End With

outmail.Send

MsgBox "邮件-" & strSubject & "已经发送至" & strTo & ",抄送至" & strCC

End Sub

如果发送时提示“有人正在试图以您的名义发送邮件。。。。。”修改一下安全性：