outlook 用宏发邮件

dsqzhaoyue

　　经常发面试邮件，通常只是修改一下收件人邮箱地址，和收件人姓名，其他全部一致，有木有发现每次都用用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 = "hanxianlong14023@sinosoft.com.cn"
strCC = "hanxianlong14023@sinosoft.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
　　
　　如果发送时提示“有人正在试图以您的名义发送邮件。。。。。”修改一下安全性：