maidinhdan > 09-04-15, 11:22 PM
' maidinhdan suu tam tai : http://support.microsoft.com/en-us/kb/318881/vi-vn
Option Explicit
Sub SendMessages(Optional AttachmentPath)
Dim MyDB As Database
Dim MyRS As Recordset
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
Dim TheAddress As String
Set MyDB = CurrentDb
Set MyRS = MyDB.OpenRecordset("tblMailingList")
MyRS.MoveFirst
' Khoi tao Outlook.
Set objOutlook = CreateObject("Outlook.Application")
Do Until MyRS.EOF
' Tao e-mail message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
TheAddress = MyRS![EmailAddress]
With objOutlookMsg
' Them dia chi nguoi nhan tin e-mail.
Set objOutlookRecip = .Recipients.Add(TheAddress)
objOutlookRecip.Type = olTo
' Them nguoi nhan Cc (Tao ban sao)
If (IsNull(Forms!frmMail!CCAddress)) Then
Else
Set objOutlookRecip = .Recipients.Add(Forms!frmMail!CCAddress)
objOutlookRecip.Type = olCC
End If
' Tieu de, noi dung Email.
.Subject = Forms!frmMail!Subject
.Body = Forms!frmMail!MainText
.Importance = olImportanceHigh 'Muc do quan trong cua la thu, mac dinh la Cao
'Dinh kem tap tin.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Loc ten tung nguoi nhan.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Send
End With
MyRS.MoveNext
Loop
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
End Sub
Private Sub cmdgui_Click()
SendMessages (Me.txtdinhkem)
End Sub
toidjtjmtoi > 27-12-19, 02:06 PM