Kiểm tra và add địa chỉ email trong range của column lên 'To' field để gửi mail

[hadoan-pap]

Em chào mọi người.

Em đang làm chương trình gửi mail tự động. Trong cột D của em có chưa các địa chỉ mail, mỗi 1 ô là 1 địa chỉ mail... File ví dụ như đính kèm ạ.

E muốn add lần lượt các địa chỉ mail theo các ô này lên trường 'To' để gửi email trong outlook với định dạng "example1@xxx; example2@xxx; example3@xxx"... Vì cột D là không cố đính số hang, nên cứ kiểm tra xem nếu nó không rỗng ( tức là có địa chỉ mail trong ô ) thì sẽ add lên .

Code em đang làm đến đoạn này , rất mong mọi người hỗ trợ em xem cần chỉnh lại như nào cho đúng với mong muốn như trên ạ .

With myMail

For i = 2 To 300
If Sheet1.Cells(i + 1, 4) <> "" Then
.To = Sheet1.Cells(i, 4) & ";" & Sheet1.Cells(i + 1, 4)
End If
Next i

End With

Em xin cảm ơn!

 

[befaint]

Email 1 2 3 4

 

[thnghiachau]

Em chào mọi người.

Em đang làm chương trình gửi mail tự động. Trong cột D của em có chưa các địa chỉ mail, mỗi 1 ô là 1 địa chỉ mail... File ví dụ như đính kèm ạ.

E muốn add lần lượt các địa chỉ mail theo các ô này lên trường 'To' để gửi email trong outlook với định dạng "example1@xxx; example2@xxx; example3@xxx"... Vì cột D là không cố đính số hang, nên cứ kiểm tra xem nếu nó không rỗng ( tức là có địa chỉ mail trong ô ) thì sẽ add lên .

Code em đang làm đến đoạn này , rất mong mọi người hỗ trợ em xem cần chỉnh lại như nào cho đúng với mong muốn như trên ạ .

With myMail

For i = 2 To 300
If Sheet1.Cells(i + 1, 4) <> "" Then
.To = Sheet1.Cells(i, 4) & ";" & Sheet1.Cells(i + 1, 4)
End If
Next i

End With

Em xin cảm ơn!

không biết code nhỏ này giúp gì được bạn không nhỉ....

Dim lLR As Long
Dim arrEmail
Dim strJoinAddress As String
lLR = Sheet1.Cells(Sheet1.Rows.Count, "D").End(xlUp).Row 'Last Row of Column "D"
If lLR >= 2 Then
    arrEmail = Application.WorksheetFunction.Transpose(Sheet1.Range("D2:D" & lLR).Value)
    strJoinAddress = Join(arrEmail, ";")
End If

 

[hadoan-pap]

Email 1 2 3 4

Dear anh.

Em cảm ơn nhiều ạ.

Đúng lúc em cũng mới sửa lại đoạn code như bên dưới và cũng đã được rồi ạ.

Dim xRg As Range
Dim xCell As Range
Dim xEmailAddr As String

Set xRg = Sheet2.Range("O5:O300")


With myMail

For Each xCell In xRg
If xCell.Value Like "*@*" Then
If xEmailAddr = "" Then
xEmailAddr = xCell.Value
Else
xEmailAddr = xEmailAddr & ";" & xCell.Value
End If
End If
Next

.To = xEmailAddr

Cảm ơn anh rất nhiều!

Bài đã được tự động gộp: 5/10/20

không biết code nhỏ này giúp gì được bạn không nhỉ....

Dim lLR As Long
Dim arrEmail
Dim strJoinAddress As String
lLR = Sheet1.Cells(Sheet1.Rows.Count, "D").End(xlUp).Row 'Last Row of Column "D"
If lLR >= 2 Then
    arrEmail = Application.WorksheetFunction.Transpose(Sheet1.Range("D2:D" & lLR).Value)
    strJoinAddress = Join(arrEmail, ";")
End If

Cảm ơn anh rất nhiều.