Note: The other languages of the website are Google-translated. Back to English

 Làm cách nào để gửi email đến nhiều người nhận trong một danh sách từ Excel qua Outlook?

Nếu bạn có nhiều địa chỉ email trong một cột của trang tính và bây giờ, bạn muốn gửi trực tiếp email đến danh sách người nhận này từ Excel mà không cần mở Outlook. Bài viết này, tôi sẽ nói về cách gửi email cho nhiều người nhận từ Excel cùng một lúc.

Gửi email đến nhiều người nhận từ Excel với mã VBA

Gửi email đến nhiều người nhận với sổ làm việc hiện tại dưới dạng tệp đính kèm bằng cách sử dụng mã VBA


mũi tên màu xanh bong bóng bên phải Gửi email đến nhiều người nhận từ Excel với mã VBA

Bạn có thể sử dụng mã VBA để gửi tin nhắn cho nhiều người nhận cùng một lúc, vui lòng thực hiện như sau:

1. Giữ phím tắt ALT + F11 phím để mở Microsoft Visual Basic cho các ứng dụng cửa sổ.

2. Nhấp chuột Chèn > Mô-đunvà dán mã sau vào Cửa sổ mô-đun.

Mã VBA: Gửi email đến nhiều người nhận

Sub sendmultiple()
'updateby Extendoffice
    Dim xOTApp As Object
    Dim xMItem As Object
    Dim xCell As Range
    Dim xRg As Range
    Dim xEmailAddr As String
    Dim xTxt As String
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the addresses list:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xOTApp = CreateObject("Outlook.Application")
    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
    Set xMItem = xOTApp.CreateItem(0)
    With xMItem
        .To = xEmailAddr
        .Display
    End With
End Sub

3. Và sau đó nhấn F5 để thực thi mã này, một hộp nhắc sẽ bật ra để nhắc bạn chọn danh sách địa chỉ, xem ảnh chụp màn hình:

doc gửi nhiều người nhận 1

4. Sau đó nhấn vào OKvà một Outlook Câu Hỏi/Nội Dung “*” cửa sổ hiển thị, bạn có thể thấy tất cả các địa chỉ email đã chọn đã được thêm vào Đến và sau đó bạn có thể nhập chủ đề và soạn tin nhắn của mình, xem ảnh chụp màn hình:

doc gửi nhiều người nhận 2

5. Sau khi kết thúc tin nhắn, vui lòng nhấp vào Gửi và thông báo này sẽ được gửi đến những người nhận này trong danh sách trang tính của bạn.


mũi tên màu xanh bong bóng bên phải Gửi email đến nhiều người nhận với sổ làm việc hiện tại dưới dạng tệp đính kèm bằng cách sử dụng mã VBA

Nếu bạn cần gửi thư đến nhiều người nhận với sổ làm việc hiện tại dưới dạng tệp đính kèm, bạn có thể áp dụng mã VBA sau.

1. Giữ ALT + F11 phím để mở Microsoft Visual Basic cho các ứng dụng cửa sổ.

2. Nhấp chuột Chèn > Mô-đunvà dán mã sau vào Cửa sổ mô-đun.

Mã VBA: Gửi email đến nhiều người nhận với sổ làm việc hiện tại dưới dạng tệp đính kèm

Sub EmailAttachmentRecipients()
'updateby Extendoffice
    Dim xOutlook As Object
    Dim xMailItem As Object
    Dim xRg As Range
    Dim xCell As Range
    Dim xEmailAddr As String
    Dim xTxt As String
    On Error Resume Next
    xTxt = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select the arresses list:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Set xOutlook = CreateObject("Outlook.Application")
    Set xMailItem = xOutlook.CreateItem(0)
    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
    With xMailItem
        .To = xEmailAddr
        .CC = ""
        .Subject = ""
        .Body = ""
        .Attachments.Add ActiveWorkbook.FullName
        .Display
    End With
    Set xOutlook = Nothing
    Set xMailItem = Nothing
End Sub

3. Sau khi dán mã, nhấn F5 để chạy mã này và một hộp nhắc xuất hiện để nhắc bạn chọn địa chỉ bạn muốn gửi tin nhắn, xem ảnh chụp màn hình:

doc gửi nhiều người nhận 3

4. Sau đó nhấn vào OK và một Outlook Câu Hỏi/Nội Dung “*” cửa sổ được hiển thị, tất cả các địa chỉ email đã được thêm vào Đến trường và sổ làm việc hiện tại của bạn cũng đã được chèn dưới dạng tệp đính kèm, sau đó bạn có thể nhập chủ đề và soạn thư, xem ảnh chụp màn hình:

doc gửi nhiều người nhận 4

5. Sau đó nhấn vào Gửi để gửi thư này đến danh sách người nhận với sổ làm việc hiện tại dưới dạng tệp đính kèm.


Gửi email được cá nhân hóa cho nhiều người nhận với các tệp đính kèm khác nhau:

Với Kutools cho Excel's Gửi email , bạn có thể nhanh chóng gửi email được cá nhân hóa cho nhiều người nhận với các tệp đính kèm khác nhau từ Excel qua Outlook khi bạn cần. Đồng thời, bạn cũng có thể CC hoặc Bcc tin nhắn cho một người cụ thể. Nhấp để tải xuống Kutools cho Excel!

doc gửi email được cá nhân hóa 18 1


Bài viết liên quan:

Làm cách nào để gửi hàng loạt email được cá nhân hóa đến một danh sách từ Excel qua Outlook?


Các công cụ năng suất văn phòng tốt nhất

Kutools cho Excel giải quyết hầu hết các vấn đề của bạn và tăng 80% năng suất của bạn

  • Tái sử dụng: Chèn nhanh công thức phức tạp, biểu đồ và bất cứ thứ gì bạn đã sử dụng trước đây; Mã hóa ô với mật khẩu; Tạo danh sách gửi thư và gửi email ...
  • Thanh siêu công thức (dễ dàng chỉnh sửa nhiều dòng văn bản và công thức); Bố cục đọc (dễ dàng đọc và chỉnh sửa số lượng ô lớn); Dán vào Dải ô đã Lọchữu ích. Cảm ơn !
  • Hợp nhất các ô / hàng / cột mà không làm mất dữ liệu; Nội dung phân chia ô; Kết hợp các hàng / cột trùng lặp... Ngăn chặn các ô trùng lặp; So sánh các dãyhữu ích. Cảm ơn !
  • Chọn trùng lặp hoặc duy nhất Hàng; Chọn hàng trống (tất cả các ô đều trống); Tìm siêu và Tìm mờ trong Nhiều Sổ làm việc; Chọn ngẫu nhiên ...
  • Bản sao chính xác Nhiều ô mà không thay đổi tham chiếu công thức; Tự động tạo tài liệu tham khảo sang Nhiều Trang tính; Chèn Bullets, Hộp kiểm và hơn thế nữa ...
  • Trích xuất văn bản, Thêm Văn bản, Xóa theo Vị trí, Xóa không gian; Tạo và In Tổng số phân trang; Chuyển đổi giữa nội dung ô và nhận xéthữu ích. Cảm ơn !
  • Siêu lọc (lưu và áp dụng các lược đồ lọc cho các trang tính khác); Sắp xếp nâng cao theo tháng / tuần / ngày, tần suất và hơn thế nữa; Bộ lọc đặc biệt bằng cách in đậm, in nghiêng ...
  • Kết hợp Workbook và WorkSheets; Hợp nhất các bảng dựa trên các cột chính; Chia dữ liệu thành nhiều trang tính; Chuyển đổi hàng loạt xls, xlsx và PDFhữu ích. Cảm ơn !
  • Hơn 300 tính năng mạnh mẽ. Hỗ trợ Office / Excel 2007-2021 và 365. Hỗ trợ tất cả các ngôn ngữ. Dễ dàng triển khai trong doanh nghiệp hoặc tổ chức của bạn. Đầy đủ tính năng Dùng thử miễn phí 30 ngày. Bảo đảm hoàn lại tiền trong 60 ngày.
tab kte 201905

Tab Office mang lại giao diện Tab cho Office và giúp công việc của bạn trở nên dễ dàng hơn nhiều

  • Cho phép chỉnh sửa và đọc theo thẻ trong Word, Excel, PowerPoint, Publisher, Access, Visio và Project.
  • Mở và tạo nhiều tài liệu trong các tab mới của cùng một cửa sổ, thay vì trong các cửa sổ mới.
  • Tăng 50% năng suất của bạn và giảm hàng trăm cú nhấp chuột cho bạn mỗi ngày!
officetab dưới cùng
Nhận xét (20)
Chưa có xếp hạng. Hãy là người đầu tiên xếp hạng!
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Điều này thật tuyệt vời, chính xác những gì tôi muốn. Vẫn có thêm một tính năng mà bạn có thể thêm tin nhắn vào dòng chủ đề bằng cách sử dụng mã .... Tôi không muốn bất cứ thứ gì trong hộp tin nhắn
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Mã VBA đang hoạt động tốt, cảm ơn bạn. Có cách nào tôi có thể tạo một ô có nút sắp xếp kích hoạt "danh sách gửi thư chọn" bật lên không? Jake
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Cảm ơn bạn đã mã. Có cách nào để tôi có thể tạo một nút lệnh trên excel và sau đó bằng cách nhấp vào nút đó, cùng một trang excel có thể được gửi cho nhiều người nhận dưới dạng tệp đính kèm.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Làm cách nào tôi có thể thực hiện việc này bằng cách sử dụng dòng BCC?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Chào Robert,
Sau khi chạy mã, cửa sổ thông báo mới sẽ được mở ra, bạn chỉ cần chèn dòng BCC dưới tab Tùy chọn, xem ảnh chụp màn hình sau:


Hy vọng nó có thể giúp bạn, cảm ơn bạn!
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Bất kỳ cách nào để sử dụng điều này để gửi từ một email được chia sẻ? Tôi dường như không thể chèn trường .SendOnBehalfOf.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào ! Hàng tháng, tôi nên gửi cùng một e-mail cho các nhà cung cấp khác nhau, nhưng chúng không nên ở cùng một e-mail ..... làm thế nào tôi có thể gửi cùng một e-mail cho các điểm đến khác nhau mà không có mọi người trong cùng một e-mail ?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Vinicius,
Để gửi riêng cùng một email đến nhiều người nhận, có thể bài viết sau đây có thể giúp ích được gì cho bạn, hãy cùng xem nhé.
https://www.extendoffice.com/documents/excel/3560-excel-send-personalized-email.html
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Buổi sáng,


Tôi chưa quen với việc cố gắng viết và sử dụng macro trong excel. Nỗ lực đầu tiên của tôi là thử tạo một tập hợp con email hàng loạt từ một danh sách tổng thể lớn. Tôi cắt và dán quy trình đầu tiên, sau đó cố gắng sử dụng tất cả những gì nó làm là đánh dấu các ô tôi yêu cầu. không có email outlook nào được tạo, tôi đã làm gì sai? Để mở rộng theo yêu cầu thực tế của tôi, tôi thực sự muốn nhắm mục tiêu các email theo mã zip hoặc các tập hợp con khác. làm cách nào để tạo một macro sẽ tìm kiếm một cột cho một mã zip nhất định và tạo một email với tất cả người nhận được tìm thấy?

cảm ơn bạn

Steve
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Tôi có Mã này, vấn đề của tôi là nó tạo một email cho mỗi lần điều kiện không hoàn thành, nhưng tôi muốn đưa tất cả thông tin không đạt được điều kiện vào chỉ một email

Sub EnviarCorreo ()
Làm mờ ứng dụng dưới dạng đối tượng
Dim OutMail làm đối tượng
Dim lLastRow As Long
Dim lHàng dài
Dim sSendTo As String
Dim sSendCC dưới dạng chuỗi
Dim sSendBCC dưới dạng chuỗi
Dim sSubject dưới dạng chuỗi
Dim sTemp dưới dạng chuỗi

Đặt OutApp = CreateObject ("Outlook.Application")
OutApp.Session.Logon

'Thay đổi những điều sau nếu cần
sSendTo = ""
sSendCC = ""
sSendBCC = ""
sSubject = "Đã đến ngày đến hạn"

Đặt OutMail = OutApp.CreateItem (0)

lLastRow = Cells (Rows.Count, 3) .End (xlUp) .Row
Đối với lRow = 3 Đến lLastRow
If Cells (lRow, 9) <> "S" Then
If Cells (lRow, 2) <= Date Then

On Error Resume Next
Với OutMail
.To = sSendTo
Nếu sSendCC> "" Thì .CC = sSendCC
Nếu sSendBCC> "" Thì .BCC = sSendBCC
.Subject = sSubject

sTemp = "Xin chào!" & vbCrLf & vbCrLf
sTemp = sTemp & "Đã đến ngày đáo hạn"
sTemp = sTemp & "cho dự án này:" & vbCrLf & vbCrLf


'ĐÂY LÀ ĐIỀU TÔI MUỐN LẶP LẠI TRÊN EMAIL BODY
'Giả sử tên dự án nằm trong cột B
sTemp = sTemp & "ID:"
sTemp = sTemp & "" & Ô (lRow, 1)
sTemp = sTemp & "Mô tả:"
sTemp = sTemp & "" & Ô (lRow, 5)
sTemp = sTemp & "Vui lòng chọn cách thích hợp"
sTemp = sTemp & "hành động." & vbCrLf & vbCrLf
sTemp = sTemp & "Cảm ơn bạn!" & vbCrLf
'CHO ĐẾN KHI TỚI ĐÂY



.Body = sTemp
'Thay đổi phần sau thành. Gửi nếu bạn muốn
'gửi tin nhắn mà không cần xem xét trước
.Trưng bày
Kết thúc với
Set OutMail = Không có gì

Ô (lRow, 9) = "S"
Cells (lRow, 10) = "E-mail được gửi vào:" & Now ()
Cuối Nếu
Cuối Nếu
Tiếp theo lRow
Đặt OutApp = Không có gì
End Sub
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Có thể ghép mã để chọn CC từ danh sách theo cùng một cách sau khi chọn TO? Với mã hiện tại, không thể chọn bất kỳ CC nào giống như TOs (địa chỉ chính). 
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào Eugen, Rất vui được giúp đỡ. Có thể ghép mã để chọn CC từ danh sách theo cách tương tự sau khi chọn TO. Và mã về cơ bản giống với mã TOs VBA. Chỉ nên thực hiện một thay đổi. Chỉ cần thay đổi ".To = xEmailAddr" thành ".Cc = xEmailAddr". Vui lòng xem ảnh chụp màn hình. Và bạn có thể chọn CC và TO từ danh sách cùng một lúc. Chỉ cần đưa ".To = xEmailAddr" và ".Cc = xEmailAddr" vào mã VBA. Vui lòng dán mã sau vào Cửa sổ mô-đun.
Sub sendmultiple ()
'cập nhật bởi Extendoffice
Làm mờ xOTApp làm đối tượng
Làm mờ xMItem làm đối tượng
Dim xCell As Range
Dim xRg theo phạm vi
Dim xEmailAddr dưới dạng Chuỗi
Làm mờ xTxt dưới dạng chuỗi
On Error Resume Next
xTxt = ActiveWindow.RangeSelection.Address
Đặt xRg = Application.InputBox ("Vui lòng chọn danh sách địa chỉ:", "Kutools cho Excel", xTxt,,,,, 8)
Nếu xRg không có gì thì thoát Sub
Đặt xOTApp = CreateObject ("Outlook.Application")
Đối với mỗi xCell Trong xRg
Nếu xCell.Value Like "* @ *" thì
Nếu xEmailAddr = "" Thì
xEmailAddr = xCell.Value
Khác
xEmailAddr = xEmailAddr & ";" & xCell.Value
Cuối Nếu
Cuối Nếu
Sau
Đặt xMItem = xOTApp.CreateItem (0)
Với xMItem
.To = xEmailAddr
.Cc = xEmailAddr
.Trưng bày
Kết thúc với
End Sub

Hy vọng nó có thể giải quyết vấn đề của bạn. Chúc một ngày tốt lành. Trân trọng, Mandy
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Tôi đang cố gắng để excel gửi email đến nhiều người nhận và có thể nhận được mọi thứ tôi cần nhưng nó từ chối đưa địa chỉ email vào hộp TO. Đây là mã tôi đã làm việc với. Bất cứ ai có thể giúp tôi tìm ra những gì tôi đang làm sai? Cám ơn rất nhiều!

Sub Macro1 ()
Dim rngCell As Range
Dim rngMyDataSet As Range
Dim Rng Như Phạm vi
Làm mờ ứng dụng dưới dạng đối tượng
Dim OutMail làm đối tượng
Dim EmailSubject dưới dạng Chuỗi
Dim EmailSendTo As String
Dim MailBody dưới dạng chuỗi
Dim EmailRecipient dưới dạng phạm vi
Chữ ký mờ dưới dạng chuỗi
Application.ScreenUpdating = Sai
Với ActiveSheet
Nếu .FilterMode thì .ShowAllData
Đặt Rng = .Range ("AK6", .Cells (.Rows.Count, 1) .End (xlUp))
Kết thúc với
Đối với mỗi rngCell Trong Rng
Nếu rngCell.Offset (0, 6)> 0 Thì

ElseIf rngCell.Offset (0, 5)> Đánh giá ("Hôm nay () +7") Và _
rngCell.Offset (0, 5). Giá trị <= Đánh giá ("Hôm nay () +30") Sau đó
rngCell.Offset (0, 6) .Value = Ngày

Đặt OutApp = CreateObject ("Outlook.Application")
Đặt OutMail = OutApp.CreateItem (0)

strbody = "Theo hồ sơ của tôi, hợp đồng của bạn" & Range ("A6"). Giá trị & "sẽ được xem xét trên" & rngCell.Offset (0, 5) .Value & vbNewLine & _
"Vui lòng xem lại hợp đồng này trước ngày thích hợp và gửi email cho tôi với bất kỳ thay đổi nào bạn thực hiện đối với hợp đồng này. Nếu hợp đồng được gia hạn, vui lòng điền vào Tờ bìa hợp đồng có thể tìm thấy trong thư mục Mọi người và gửi cho tôi hợp đồng gốc mới. "
EmailSendTo = rngCell.Offset (0, 0) .Value
EmailSubject = Trang tính ("sheet1"). Phạm vi ("A6"). Giá trị
Signature = "C: \ Documents and Settings \" & Environ ("rmm") & _
"\ Dữ liệu Ứng dụng \ Microsoft \ Chữ ký \ rm.htm"
On Error Resume Next
Với OutMail
.To = EmailSendTo
.CC = "hhh@gmail.com"
.BCC = ""
.Subject = EmailSubject
.Body = strbody
.Trưng bày
Send_Value = Mail_Recipient.Offset (i - 1) .Value
Kết thúc với
Về lỗi GoTo 0
Set OutMail = Không có gì
Đặt OutApp = Không có gì

Cuối Nếu

RngCell tiếp theo
Application.ScreenUpdating = True
End Sub
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Diana,
Có thể bạn có thể áp dụng mã dưới đây:

Sub Macro1()
Dim rngCell As Range
Dim Rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim EmailSubject As String
Dim EmailSendTo As String
Dim MailBody As String
Dim Signature As String
Application.ScreenUpdating = False
On Error Resume Next
With ActiveSheet
  If .FilterMode Then .ShowAllData
  Set Rng = .Range("AK6", .Cells(.Rows.Count, 1).End(xlUp))
End With
Set OutApp = CreateObject("Outlook.Application")
For Each rngCell In Rng
  If rngCell.Offset(0, 6) > 0 Then
    If rngCell.Offset(0, 5).Value > Evaluate("Today() +7") And _
       rngCell.Offset(0, 5).Value <= Evaluate("Today() +30") Then
      rngCell.Offset(0, 6).Value = Date
    End If
    Set OutMail = OutApp.CreateItem(0)
    MailBody = "According to my records, your contract " & Range("A6").Value & " is due for review on " & rngCell.Offset(0, 6).Value & vbNewLine & _
               "Please review this contract prior to the pertinent date and email me with any changes you make to this contract. If it is renewed, " & _
               "please fill out the Contract Cover Sheet which can be found in the Everyone folder and send me the new original contract."
    
    EmailSendTo = rngCell.Offset(2, 6).Value   'Please specify the row and column number of the addresses in the filtered data range,please change the number 2 and 6 to your need
    EmailSubject = Sheets("sheet1").Range("A6").Value
    Signature = "C:\Documents and Settings\" & Environ("rmm") & _
                "\Application Data\Microsoft\Signatures\rm.htm"
    With OutMail
      .To = EmailSendTo
      .CC = "hhh@gmail.com"
      .BCC = ""
      .Subject = EmailSubject
      .Body = MailBody
      .Recipients.ResolveAll
      .Display
    End With
  End If
Next rngCell
Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub



EmailSendTo = rngCell.Offset (2, 6) .Value, bạn nên thay đổi số 2 và 6 thành số hàng và cột dựa trên phạm vi dữ liệu của bạn, phạm vi này chứa các địa chỉ email bạn muốn gửi đến.

Hãy cố gắng, hy vọng nó có thể giúp bạn!
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Cảm ơn bạn nhưng tiếc là nó đã không hoạt động. Tôi vẫn nhận được kết quả tương tự.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Diana,
Trong trường hợp này, vui lòng cung cấp ảnh chụp màn hình hoặc tệp đính kèm của dữ liệu trang tính để chúng tôi có thể xác định vấn đề nằm ở đâu.
Hoặc bạn có thể mô tả vấn đề của mình rõ ràng và chi tiết hơn.
Cảm ơn bạn!
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Dưới đây là mã hiện tại tôi đang sử dụng nhưng nó sẽ không đặt từng địa chỉ email vào hộp ĐẾN, chỉ có địa chỉ email đầu tiên trong tất cả chúng. Cũng làm điều tương tự với SUBJECT và trong email, nó chỉ sử dụng lặp lại cùng một điều. Tôi không chắc về cách đính kèm bảng tính vào email này.

Sub Macro1 ()
Dim rngCell As Range
Dim rngMyDataSet As Range
Dim Rng Như Phạm vi
Làm mờ ứng dụng dưới dạng đối tượng
Dim OutMail làm đối tượng
Dim EmailSubject dưới dạng Chuỗi
Dim EmailSendTo As String
Dim MailBody As Range
Dim EmailRecipient dưới dạng phạm vi
Chữ ký mờ dưới dạng chuỗi
Application.ScreenUpdating = Sai
Với ActiveSheet
Nếu .FilterMode thì .ShowAllData
Đặt Rng = .Range ("AJ6", .Cells (.Rows.Count, 1) .End (xlUp))
Kết thúc với
Đối với mỗi rngCell Trong Rng
Nếu rngCell.Offset (0, 6)> 0 Thì

ElseIf rngCell.Offset (0, 5)> Đánh giá ("Hôm nay () +7") Và _
rngCell.Offset (0, 5). Giá trị <= Đánh giá ("Hôm nay () +120") Sau đó
rngCell.Offset (0, 6) .Value = Ngày

Đặt OutApp = CreateObject ("Outlook.Application")
Đặt OutMail = OutApp.CreateItem (0)

strbody = "Theo hồ sơ của tôi, hợp đồng" & Phạm vi ("A6") của bạn. Giá trị & "sắp được xem xét" & rngCell.Offset (0, 5). Giá trị & _
". Điều quan trọng là bạn phải xem lại hợp đồng này càng sớm càng tốt và gửi email cho tôi với bất kỳ thay đổi nào được thực hiện. Nếu nó được gia hạn, vui lòng điền vào Tờ bìa hợp đồng có thể tìm thấy trong thư mục Mọi người và gửi cho tôi tờ bìa cùng với hợp đồng gốc mới . "
EmailSendTo = Sheets ("sheet1"). Phạm vi ("AJ6"). Giá trị
EmailSubject = Trang tính ("sheet1"). Phạm vi ("A6"). Giá trị
Signature = "C: \ Documents and Settings \" & Environ ("rmm") & _
"\ Dữ liệu Ứng dụng \ Microsoft \ Chữ ký \ rm.htm"
On Error Resume Next
Với OutMail
.To = EmailSendTo
.CC = "hhh@gmail.com"
.BCC = ""
.Subject = EmailSubject
.Body = strbody
.Trưng bày
Send_Value = Mail_Recipient.Offset (i - 1) .Value
Kết thúc với
Về lỗi GoTo 0
Set OutMail = Không có gì
Đặt OutApp = Không có gì

Cuối Nếu

RngCell tiếp theo
Application.ScreenUpdating = True
End Sub
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Chào bạn,
Bạn có thể chèn sổ làm việc của mình dưới dạng tệp đính kèm tại đây, vui lòng xem ảnh chụp màn hình bên dưới:
https://www.extendoffice.com/images/stories/comments/comment-skyyang/doc-attachment-1.png
Cảm ơn bạn!
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Không có hộp "Tải lên tệp đính kèm" ở phía cuối của tôi.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Diana,
Nếu không có hộp "Tải lên Tệp đính kèm", bạn nên đăng ký trước, sau đó tùy chọn "Tải lên Tệp đính kèm" sẽ xuất hiện.
Để đăng ký, vui lòng lên đầu bài viết và nhấp vào Đăng ký lại nút để bắt đầu.
https://www.extendoffice.com/images/stories/comments/comment-skyyang/doc-register.png
Tôi xin lỗi vì sự bất tiện.
Không có bình luận nào được đăng ở đây
Để lại ý kiến ​​của bạn
Đăng với tư cách khách
×
Đánh giá bài viết này:
0   Nhân vật
Các vị trí được đề xuất

Kết nối với chúng tôi

Bản quyền © 2009 - www.extendoffice.com. | Đã đăng ký Bản quyền. cung cấp bởi ExtendOffice. | BẢN ĐỒ CHI NHÁNH
Microsoft và logo Office là các nhãn hiệu hoặc nhãn hiệu đã đăng ký của Microsoft Corporation tại Hoa Kỳ và / hoặc các quốc gia khác.
Được bảo vệ bởi Sectigo SSL