Giúp đỡ về cách gửi mail tự động theo danh sách

Chia sẻ bởi:hands

★★★★★

‹ {Hỏi về macro làm tiến độ} Dò tìm trả về kết quả tất... ›

Quảng cáo

Em có thắc mắc về cách gửi mail trên outlook thông qua file macro, mong được anh chị giải đáp và chỉ bảo, trình độ vba của em còn non kém mong anh chị đừng chửi tội nghiệp em .(@$%@
vấn đề như sau ạ:
Em có 1 file danh sách và em muốn làm 1 file macro với nút bấm để gửi mail cho tiện ạ. file macro có 2 nút bấm, 1 nút gửi mail tới tất cả mọi người. Nút còn lại thì khi nào mà có người chưa đăng ký thì gửi tiếp thêm 1 lần nữa để nhắc họ đăng ký, nếu mọi người đăng ký xong rồi thì sẽ gửi mail đến mình và sếp.

file danh sách thì có tên từng người và mail ở phía dưới, vì là file dùng chung nên được để trong đường dẫn để mọi người tự điền, khi điền thông tin xong sẽ chọn "ok" còn ai chưa làm thì chắc chắn sẽ là "chua" rồi ạ. dựa vào đó để gửi mail nhắc họ điền ấy ạ.

file macro thì có body với tiêu đề sẵn, với ngày hết hạn đăng ký. dựa vào đó để mình điền thông tin trong macro cho nhanh ạ.
Rất mong được các anh chị chỉ bảo ạ. Em xin cám ơn nhiều ạ.

Bạn thử tải về và sửa lại cho phù hợp, trong file đính kèm có cả trang hướng dẫn:

Option Explicit

Sub tenkai()
    Dim ws As Worksheet
    Dim objoutlook As Object
    Dim objmail As Object
    Dim nowrow As Integer

'tao bien gan cho sheet can xu lyu
    Set ws = Workbooks("danhsach.xlsx").Worksheets("danhsachdk")

'gan bien cho outlook object]
    Set objoutlook = CreateObject("Outlook.Application")
    nowrow = 12

Do While True
        nowrow = nowrow + 1
        'sua hang trong
        If ws.Cells(7, nowrow) = "" Then Exit Do
        '対象行に値が[chua]入力されていれば、メール下書きを作成する
        If ws.Cells(8, nowrow) = "Chua" Then
            Set objmail = objoutlook.CreateItem(0)

With objmail

.subject = ThisWorkbook.Sheets("lan2").Range("B2").Value

'ten nguoi nhan
                .To = ws.Cells(7, nowrow).Value

'noi dung
                .Body = ws.Cells(6, nowrow).Value & vbCrLf & _
                        ThisWorkbook.Sheets("lan2").Range("C2").Value & vbCrLf & vbCrLf
                .Display

End With
        End If

Loop

Set objoutlook = Nothing
 MsgBox "done"

End Sub

End Sub