Gửi email từ excel bằng VBA

[batman1]

Thế thì tôi chịu.

 

[nguyenthuy13388]

@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 ạ

Bạn thử code này xem sao:

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

 

[hoangtuaotrang_hp_vn]

Bạn thử code này xem sao:

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

Khi 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

 

[nguyenthuy13388]

Khi 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

Xem file bạn nhé, code đó đâu phải của tôi

 

[hoangtuaotrang_hp_vn]

Xem file bạn nhé, code đó đâu phải của tôi

Em cảm ơn bác nhiều lắm