Access或Excel VBA使用CDO批量发送邮件

ACCESS及VBA可以通过微软的CDO来发送邮件， （不需要安装其他控件和引用DLL库文件）这样使用非常方便，比调用Outlook的MAPI更加方便

 

Dim objEmail As Object
Dim strName As String

 

Private Sub Form_Load()
    strName = "http://schemas.microsoft.com/cdo/configuration/"
    Set objEmail = CreateObject("CDO.Message")
End Sub

Private Sub Command1_Click()
    Me.Caption = "正在发送..."
    Command1.Enabled = False
    objEmail.From = "tmtony@21cn.com"
    objEmail.To = "test@qq.com"
    objEmail.Subject = "邮件发送测试(Access交流网)"
    objEmail.Textbody = "邮件发送测试内容(Office中国交流网）"
    objEmail.Configuration.Fields.Item(strName & "sendusing") = 2
    objEmail.Configuration.Fields.Item(strName & "smtpserver") = "smtp.21cn.com"
    objEmail.Configuration.Fields.Item(strName & "smtpserverport") = 25
    objEmail.Configuration.Fields.Item(strName & "smtpauthenticate") = 1
    objEmail.Configuration.Fields.Item(strName & "sendusername") = "tmtony@21cn.com"
    objEmail.Configuration.Fields.Item(strName & "sendpassword") = "XXXXXXXXXX"
    objEmail.Configuration.Fields.Update
    objEmail.Send
    Command1.Enabled = True
    Me.Caption = "Send OK!"
    MsgBox "邮件发送成功，谢谢，欢迎您使用Access交流网的代码"
    End
End Sub