Option Explicit Const EMBED_ATTACHMENT As Long = 1454
Sub Send_Mail()
Dim stFileName As String
Dim stPath As String
Dim stSubject As String
Dim vaMsg As Variant
Dim vaCopyTo As Variant
Dim vaEnclosure As Variant
Dim vaBr As Variant
Dim vaRecipients As Variant
Dim cell As Range
Dim noSession As Object
Dim noDatabase As Object
Dim noDocument As Object
Dim noEmbedObject As Object
Dim nAtt As Object
Dim noAttachment As Object
Dim stAttachment As String
Dim Addresslist As Object
Application.ScreenUpdating = False
Set Addresslist = CreateObject("Scripting.Dictionary")
stPath = Sheets("Setup").Range("I5").Value
stSubject = Sheets("Setup").Range("I3").Value
vaMsg = Sheets("Setup").Range("I6").Value
vaCopyTo = Sheets("Setup").Range("I4").Value
vaEnclosure = Sheets("Setup").Range("I12").Value
vaBr = Sheets("Setup").Range("I14").Value
For Each cell In Columns("D").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "E").Value) = "x" Then
On Error Resume Next
Addresslist.Add cell.Value, cell.Value
If Err.Number = 0 Then
'Copy the active sheet to a new temporarily workbook.
'With ActiveSheet
' .Copy
stFileName = LCase(Cells(cell.Row, "F").Value)
'End With stAttachment = stPath & "\" & stFileName & ".xlsx"
'Save and close the temporarily workbook.
'With ActiveWorkbook
' .SaveAs stAttachment
' .Close
'End With
' WB.SaveAs FileName:="C:\" & FileName
'Instantiate the Lotus Notes COM's Objects.
Set noSession = CreateObject("Notes.NotesSession")
Set noDatabase = noSession.GETDATABASE("", "")
'If Lotus Notes is not open then open the mail-part of it.
If noDatabase.IsOpen = False Then noDatabase.OPENMAIL
'Create the e-mail and the attachment.
Set noDocument = noDatabase.CreateDocument
'Add values to the created e-mail main properties.
With noDocument
Set nAtt = noDocument.CreateRichTextItem("body")
.Form = "Memo"
.SendTo = cell.Value
.CopyTo = vaCopyTo
.Subject = stSubject
With nAtt
.AppendText (vaMsg & vbNewLine)
.AddNewLine
.AddNewLine
.AppendText (vaBr & vbNewLine)
.AddNewLine
'Call .EmbedObject(EMBED_ATTACHMENT, "", stAttachment)
'.EmbedObject (noEmbedObject) '1454 = Constant for EMBED_ATTACHMENT
'1454 = Constant for EMBED_ATTACHMENT
'Set noAttachment = noDocument.CreateRichTextItem("stAttachment")
Set noEmbedObject = nAtt.EmbedObject(EMBED_ATTACHMENT, "", stAttachment) '1454 = Constant for EMBED_ATTACHMENT .AddNewLine
.AppendText (vaBr & vbNewLine)
.AddNewLine
.AppendText (Range("MailEnclosure").Value)
.AddNewLine
End With .SaveMessageOnSend = True .PostedDate = Now()
.Send 0, cell.Value
End With
'Delete the temporarily workbook.
End If
On Error GoTo 0
End If
Next cell
'Release objects from memory.
Set noEmbedObject = Nothing
Set noAttachment = Nothing
Set noDocument = Nothing
Set noDatabase = Nothing
Set noSession = Nothing
MsgBox "The e-mail has successfully been created and distributed", vbInformation End Sub
). Hiện tại đã sắp hoàn thành được vấn đề bấy lâu nay.
