Nhờ giúp - code excel để tự động gửi email nội dung chúc mừng sinh nhật trong Outlook

[demxuan2312]

Em có 1 file excel đã tạo sẵn nội dung email "chúc mừng sinh nhật" để gửi tới các khách hàng vào ngày sinh của họ như đính kèm, nhưng chưa biết cách tạo code để hệ thống tự gửi email đi.

Ngoài ra em cũng hỏi là trong nội dung thư chúc mừng sinh nhật em muốn đặt bức hình bánh gato mừng sinh nhật để khi gửi email đi cũng có hình ảnh này thì làm thế nào ?

Xin nhờ các anh chị trong diễn đàn giúp.

Em xin cảm ơn.

 

[Hai Lúa Miền Tây]

Em có 1 file excel đã tạo sẵn nội dung email "chúc mừng sinh nhật" để gửi tới các khách hàng vào ngày sinh của họ như đính kèm, nhưng chưa biết cách tạo code để hệ thống tự gửi email đi.

Ngoài ra em cũng hỏi là trong nội dung thư chúc mừng sinh nhật em muốn đặt bức hình bánh gato mừng sinh nhật để khi gửi email đi cũng có hình ảnh này thì làm thế nào ?

Xin nhờ các anh chị trong diễn đàn giúp.

Em xin cảm ơn.

Bạn dùng code sau:

Private Sub Workbook_Open()
    Dim OutlookApp As Object, MailItem As Object, rng As Range
    With Sheet1
        For Each rng In .[D9:D15]
           If rng = .[d7] Then
                .[E5:H5].CopyPicture
                Set OutlookApp = CreateObject("Outlook.Application")
                Set MailItem = OutlookApp.CreateItem(0)
                With MailItem
                   .To = rng.Offset(, 1)
                   .Subject = Sheet1.Range("c4")
                   Sheet1.[e4] = rng.Offset(, -2)
                   .HTMLBody = "<BR><BR>" & Sheet1.Range("c5")
                   .Display
                End With
                SendKeys "^({v})", True
           End If
        Next
       
    End With
    Set OutlookApp = Nothing
    Set MailItem = Nothing
End Sub

 

[manhnt1974]

Mình đã copy vào macro rồi nhưng vẫn không chạy được
Bạn có thể hướng dẫn chi tiết cách làm được không
Khi chạy báo lỗi: "Expected end sub"
Cảm ơn nhiều

 

[manhnt1974]

Sub CM()
Private Sub Workbook_Open()
Dim OutlookApp As Object, MailItem As Object, rng As Range
With Sheet1
For Each rng In .[D915]
If rng = .[d7] Then
.[E5:H5].CopyPicture
Set OutlookApp = CreateObject("Outlook.Application")
Set MailItem = OutlookApp.CreateItem(0)
With MailItem
.To = rng.Offset(, 1)
.Subject = Sheet1.Range("c4")
Sheet1.[e4] = rng.Offset(, -2)
.HTMLBody = "<BR><BR>" & Sheet1.Range("c5")
.Display
End With
SendKeys "^({v})", True
End If
Next

End With
Set OutlookApp = Nothing
Set MailItem = Nothing
End Sub

 

[manhnt1974]

Và có thể tạo thêm màu nền và chữ ký cho thư để cho phong phú được không
Trân trọng cảm ơn

 

[ngocnd.ybi]

Hi các Anh!
Có thể hỗ trợ tiếp e phầnnày được không ạ. Thanks !

 

[MinhKhai]

Bạn dùng code sau:

Private Sub Workbook_Open()
    Dim OutlookApp As Object, MailItem As Object, rng As Range
    With Sheet1
        For Each rng In .[D9:D15]
           If rng = .[d7] Then
                .[E5:H5].CopyPicture
                Set OutlookApp = CreateObject("Outlook.Application")
                Set MailItem = OutlookApp.CreateItem(0)
                With MailItem
                   .To = rng.Offset(, 1)
                   .Subject = Sheet1.Range("c4")
                   Sheet1.[e4] = rng.Offset(, -2)
                   .HTMLBody = "<BR><BR>" & Sheet1.Range("c5")
                   .Display
                End With
                SendKeys "^({v})", True
           End If
        Next
      
    End With
    Set OutlookApp = Nothing
    Set MailItem = Nothing
End Sub

Code chạy báo lỗi chỗ này là sao anh @Hai Lúa Miền Tây ơi

 

[Hai Lúa Miền Tây]

View attachment 204550
Code chạy báo lỗi chỗ này là sao anh @Hai Lúa Miền Tây ơi

Vậy phải xem file của bạn như thế nào nhé.

 

[PhanTuHuong]

Có điều kiện quan trọng mà không thấy ai nhắc tới

 

[khaiser]

Có điều kiện quan trọng mà không thấy ai nhắc tới

mình điền cái email người gửi ở đâu vậy bạn ơi ??

 

[khanhhero]

mình điền cái email người gửi ở đâu vậy bạn ơi ??

Theo code này thì tự lấy tài khoản mặc định của outlook để gửi nhé bạn.