Gửi mail hàng loạt

[tuanxitin]

Dear anh/chị

Lúc trước cơ quan em xài phần mềm outlook.com, em viết code VBA gửi hàng loạt được. Tuy nhiên, từ khi chuyển qua outlook365, em sửa code lại bị lỗi. nhờ anh/chị xem giúp em ạ, em cảm ơn
Sub Send_Mail()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim ct1 As String
Dim ct2 As String

Dim cont As String
Dim i As Integer, n As Integer


ct1 = Sheets("Set_up").Range("B8")
ct2 = Sheets("Set_up").Range("B9")
ct3 = Sheets("Set_up").Range("B10")
ct4 = Sheets("Set_up").Range("B11")
ct5 = Sheets("Set_up").Range("B12")

cont = ct1 & vbLf & ct2 & vbLf & ct3 & vbLf & ct4 & vbLf & ct5

Sheets("Set_up").Select
Range("J3").Select
Range(Selection, Selection.End(xlDown)).Select
n = Selection.Count

Sheets("Set_up").Select
Range("Group").Select

For i = 1 To n
Group = Trim(Sheets("Set_up").Cells(i + 2, 10).Value)
Sheets("Set_up").Range("Group").Value = Group

Set OutApp = CreateObject("Outlook.office.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
'With OutMail
'.Display
'End With
Signature = OutMail.htmlBody

On Error Resume Next

With OutMail
.To = Trim(Sheets("Set_up").Range("Recipient").Value)
.cc = Trim(Sheets("Set_up").Range("Cc").Value)
.Subject = Trim(Sheets("Set_up").Range("Subject").Value)
.Body = cont
.Attachments.Add Trim(Sheets("Set_up").Range("PathFileA").Value)
.Attachments.Add Trim(Sheets("Set_up").Range("PathFileB").Value)
.Send
End With
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Sheets("Set_up").Cells(i + 2, 8).Value = "Complete"
Next i
End Sub