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