Giúp em sửa lỗi sau khi Cập nhật office từ 2007 lên 2010, các code liên quan đến gửi mail VBA bị lỗi.

anh1234

Thành viên mới

5/3/19

Dear Các bác.
Sau khi chuyển máy, chuyển từ excel 2007 lên office 2010, toàn bộ các Code VBA liên quan đến gửi mail, đều báo lỗi:
Run-time error'-2147417851(80010105)'.
Method 'To' of object '_Mailtem'faied.
Em không rõ là lỗi code, hay em chưa cài đầy đủ các phần trong ofice 2010. Các code này, em chuyển sang máy cũ của em 2007 vẫn dùng vẫn bình thường, sang máy mới cài ofice 2010 là không chạy được.

Code
Option Explicit
Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
Sub TachFile()
Dim data As Range, cll As Range
Dim sTo, ssub, sBody, bodyString, Signature, SigString As String
Set data = [a1].CurrentRegion
SigString = Environ("appdata") & _
"\Microsoft\Signatures\CHUKY.htm"
bodyString = "D:\M\DT.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If

If Dir(bodyString) <> "" Then
sBody = GetBoiler(bodyString)
Else
sBody = ""
End If
For Each cll In Range([A2], [A100000].End(3))
If cll.Value <> cll.Offset(1, 0).Value Then
data.AutoFilter 1, cll
data.SpecialCells(12).Copy
With Workbooks.Add
.ActiveSheet.[a1].PasteSpecial 1
.SaveAs ThisWorkbook.Path & "\" & cll & ".xlsx"
.Close
End With
data.AutoFilter
With CreateObject("Outlook.Application")
.Session.Logon
With .CreateItem(0)
.To = cll.Offset(, 24)
.CC = cll.Offset(, 25)
'.BCC = cll.Offset(,37) S? c?t t? c?t A ??n c?t ?i?n Mail BCC tr? 1
.Attachments.Add ThisWorkbook.Path & "\" & cll & ".xlsx"
.Subject = "TEST"
.HTMLBody = sBody & "<br>" & Signature
.send
End With
End With
End If
Next
End Sub
Kính mong các bác giúp em ạ. Trân trọng cảm ơn.