Hướng dẫn sửa code gửi mail tự động trong outlook

[DLH96]

Chào tất cả mọi người.
Nhờ mọi người xem và hỗ trợ giúp.

Mình có 1 file gửi mail tự động được lấy trên diễn đàn GPE về và có chỉnh sửa lại 1 chút.
Điểm vấn đề là tại Cột D mình dùng VLOOKUP để tìm địa chỉ mail của nhân viên, thì file không chạy code,
Coppy dán thì code hiểu và chạy bình thường.

Nhờ mọi người chỉnh sửa lại giúp.
Mình cảm ơn.

 

[hvnhpro]

bạn đang dùng đoạn code

For Each cell In Columns("D").Cells.SpecialCells(xlCellTypeConstants)

Thì không chạy được nếu dùng công thức rồi.
Bạn có xác định được dòng cuối chứa dữ liệu của cột D ko, mình thử dùng

Do không rõ nhu cầu của bạn nên mình tạm sửa thành như thế này.

    For Each cell In ActiveSheet.UsedRange.Columns("D").Cells
    On Error Resume Next

Không thì bạn chờ Anh chị khác giúp vậy

 

[DLH96]

bạn đang dùng đoạn code

For Each cell In Columns("D").Cells.SpecialCells(xlCellTypeConstants)

Thì không chạy được nếu dùng công thức rồi.
Bạn có xác định được dòng cuối chứa dữ liệu của cột D ko, mình thử dùng

Do không rõ nhu cầu của bạn nên mình tạm sửa thành như thế này.

Ý định của mình là như thế này.
Khi nhập MSNV thì cột địa chỉ mail tự động cập nhật.
Khi cột điều kiện gửi mail (cột O) chọn yes, thì mới cho phép gửi mail.

Code của mình cop nhặt được chỉ cho phép gửi mail khi ô địa chỉ không có công thức.
Mình không rành về code nên làm phiền bạn xem chỉnh sửa lại 1 chút.

Mình cảm ơn.

 

[hvnhpro]

vẫn câu hỏi cũ "bạn có xác định được dòng cuối chứa dữ liệu của cột D ko"?
trong cột D, file gốc của bạn có dòng nào bị #N/A, bị lỗi như file gửi lên đây ko.
Mình đang bị vướng lỗi #N/A nên chưa giúp bạn được.
Nếu không chờ Anh Chị khác vậy

 

[DLH96]

vẫn câu hỏi cũ "bạn có xác định được dòng cuối chứa dữ liệu của cột D ko"?
trong cột D, file gốc của bạn có dòng nào bị #N/A, bị lỗi như file gửi lên đây ko.
Mình đang bị vướng lỗi #N/A nên chưa giúp bạn được.
Nếu không chờ Anh Chị khác vậy

Dữ liệu cột D mình khoảng 600 dòng.
Không có dòng nào #N/A hết.

 

[hvnhpro]

Trong khi chờ anh chị khác giúp bạn sửa theo cách mình nói trên để dùng tạm nhé.

Dữ liệu cột D mình khoảng 600 dòng.
Không có dòng nào #N/A hết.

Sub SendMail()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim Addresslist As Scripting.Dictionary
    Application.ScreenUpdating = False
    Set Addresslist = New Scripting.Dictionary
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon

    'For Each cell In Columns("D").Cells.SpecialCells(xlCellTypeConstants)
    For Each cell In ActiveSheet.UsedRange.Columns("D").Cells
    On Error Resume Next ' Sua loi #N/A
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "O").Value) = "yes" Then
            On Error Resume Next
            Addresslist.Add cell.Value, cell.Value
            If Err.Number = 0 Then
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = cell.Value
                    .Subject = Sheet1.[E2] & " - " & Cells(cell.Row, "F").Value
                    .Body = "Dear " & Sheet1.[C1] & " " & Cells(cell.Row, "C") & " - " & Cells(cell.Row, "B").Value _
                          & vbNewLine & vbNewLine & _
                          Sheet1.[G2] & " " & Sheet1.[H2] & _
                            vbNewLine & vbNewLine & _
                           Sheet1.[I1] & " " & Cells(cell.Row, "I").Value & _
                              vbNewLine & vbNewLine & _
                           Sheet1.[J2] & _
                            vbNewLine & vbNewLine & _
                           Sheet1.[K2] & _
                            vbNewLine & vbNewLine & _
                           Sheet1.[L2] & _
                           vbNewLine & vbNewLine & _
                           Sheet1.[M2] & _
                           vbNewLine & _
                           Sheet1.[N2]
                    .Display  'Or use Send
                End With
                Set OutMail = Nothing
            End If
            On Error GoTo 0
        End If
    Next cell

    Set OutApp = Nothing
    Set Addresslist = Nothing
    Application.ScreenUpdating = True
End Sub