Bạn thử code này xem sao:@befaint : anh ơi, sau 1 hồi mày mò, thì em làm được phần dữ liệu rồi. Tuy nhiên khi nhận được mail thì phần định dạng bảng biểu bị mất, anh giúp em với ạ
Sub Sendmail()
Dim OutApp As Object
Dim OutMail As Object
Dim ETo As String, Chude As String
Dim i As Long, LValue As long
With Sheets("Bang Luong")
LValue = .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row-1).Value
End With
With Sheets("Form Email")
For i = 1 To LValue
.Range("H10").Value = i
ETo = .Range("F4").Value
Chude = .Range("B2").Value
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.To = Eto
.cc = ""
.BCC = ""
.Subject = Chude
'.Attachments.Add ActiveWorkbook.FullName
.Display '.send: Nếu muốn gửi ngay
Dim wdDoc As Object '## Word.Document
Dim wdRange As Object '## Word.Range
Set wdDoc = OutMail.GetInspector.WordEditor
Set wdRange = wdDoc.Range(0, 0)
Sheets("Form Email").Range("B4:G38").Copy
wdRange.Paste 'Special (Value): nếu muốn gửi nội dung dạng value (không có định dạng)
End With
Application.CutCopyMode = False
Set OutMail = Nothing
Set OutApp = Nothing
Next i
End With
End Sub
Bạn thử code này xem sao:
Mã:Sub Sendmail() Dim OutApp As Object Dim OutMail As Object Dim ETo As String, Chude As String Dim i As Long, LValue As long With Sheets("Bang Luong") LValue = .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row-1).Value End With With Sheets("Form Email") For i = 1 To LValue .Range("H10").Value = i ETo = .Range("F4").Value Chude = .Range("B2").Value Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With OutMail .To = Eto .cc = "" .BCC = "" .Subject = Chude '.Attachments.Add ActiveWorkbook.FullName .Display '.send: Nếu muốn gửi ngay Dim wdDoc As Object '## Word.Document Dim wdRange As Object '## Word.Range Set wdDoc = OutMail.GetInspector.WordEditor Set wdRange = wdDoc.Range(0, 0) Sheets("Form Email").Range("B4:G38").Copy wdRange.Paste 'Special (Value): nếu muốn gửi nội dung dạng value (không có định dạng) End With Application.CutCopyMode = False Set OutMail = Nothing Set OutApp = Nothing Next i End With End Sub
Xem file bạn nhé, code đó đâu phải của tôiKhi em chọn From....To... rồi nhấn send thì nó báo lỗi này ạ, anh/chị xem giùm em với
View attachment 230032
View attachment 230031
Em cảm ơn bác nhiều lắmXem file bạn nhé, code đó đâu phải của tôi
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2