Mã:
Dim OutApp As Object, OutMail As Object
Dim lr As Long
Dim Rng As Range
Dim sBaseFileName As String, sFilename As String
Set OutApp = CreateObject("Outlook.Application")
lr = Cells(Rows.Count, 1).End(xlUp).Row
sBaseFileName = "C:\Documents and Settings\Administrator\Desktop\DMH61" ' Duong dan luu file bang luong
For Each Rng In Range("A2:A" & lr)
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.to = Rng.Offset(0, 1).Value ' Insted of individual Emal i want Range of emali adress base on Name
.CC = ""
.BCC = ""
.Subject = "Chi Tiet Bang Luong"
.Body = "Nguy" & ChrW$(234) & "n t" & ChrW$(7855) & "c: L" & ChrW$(224) & "m tr" & ChrW$(225) & "ch nhi" & ChrW$(7879) & "m h" & ChrW$(432) & ChrW$(7903) & "ng " & ChrW$(273) & ChrW$(7911) & " l" & ChrW$(432) & ChrW$(417) & "ng, l" & ChrW$(224) & "m k" & ChrW$(233) & "m h" & ChrW$(432) & ChrW$(7903) & "ng " & ChrW$(237) & "t, l" & ChrW$(224) & "m thi" & ChrW$(7871) & "u tr" & ChrW$(225) & "ch nhi" & ChrW$(7879) & "m b" & ChrW$(7883) & " tr" & ChrW$(7915) & " l" & ChrW$(432) & ChrW$(417) & "ng, vi ph" & ChrW$(7841) & "m g" & ChrW$(226) & "y h" & ChrW$(7853) & "u qu" & ChrW$(7843) & " l" & ChrW$(7899) & "n ho" & ChrW$(7863) & "c li" & ChrW$(234) & "n t" & ChrW$(7909) & "c b" & ChrW$(7883) & " cho th" & ChrW$(244) & "i vi" & ChrW$(7879) & "c."
'.Attachments.Add ActiveWorkbook.FullName 'Not necessary for your needs
'You can add other files also like this
sFilename = sBaseFileName & "\" & Rng.Value & ".xlsx"
.Attachments.Add (sFilename)
.Send 'or use .Display
End With
Set OutMail = Nothing
On Error GoTo 0 'Reset Error Handling
Next
'Clear Variables
Set OutApp = Nothing
End Sub
Microsoft Office Excel is wating for another application to complete an OLE action.
Mình có một đoạn code gửi email tự động tham khảo trên mạng. Nhưng Excel hiện cảnh báo như trên, không biết có cách nào khắc phục triệt để không ah. Mong nhận được trợ giúp từ mọi người.Chân thành cảm ơn!
