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

 จะส่งอีเมลไปยังผู้รับหลายคนในรายการจาก Excel ผ่าน Outlook ได้อย่างไร

หากคุณมีที่อยู่อีเมลหลายรายการในคอลัมน์ของแผ่นงานและตอนนี้คุณต้องการส่งอีเมลไปยังรายชื่อผู้รับจาก Excel โดยตรงโดยไม่ต้องเปิด Outlook บทความนี้ฉันจะพูดถึงวิธีการส่งอีเมลไปยังผู้รับหลายคนจาก Excel ในเวลาเดียวกัน

ส่งอีเมลไปยังผู้รับหลายคนจาก Excel ด้วยรหัส VBA

ส่งอีเมลไปยังผู้รับหลายคนพร้อมสมุดงานปัจจุบันเป็นไฟล์แนบโดยใช้รหัส VBA


ลูกศรสีฟ้าฟองขวา ส่งอีเมลไปยังผู้รับหลายคนจาก Excel ด้วยรหัส VBA

คุณสามารถใช้รหัส VBA เพื่อส่งข้อความไปยังผู้รับหลายคนพร้อมกันได้โปรดดำเนินการดังนี้:

1. ค้างไว้ ALT + F11 คีย์เพื่อเปิด Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง

2. คลิก สิ่งที่ใส่เข้าไป > โมดูลและวางรหัสต่อไปนี้ในไฟล์ หน้าต่างโมดูล.

รหัส VBA: ส่งอีเมลไปยังผู้รับหลายคน

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. จากนั้นกด F5 คีย์เพื่อดำเนินการรหัสนี้กล่องพร้อมต์จะปรากฏขึ้นเพื่อเตือนให้คุณเลือกรายการที่อยู่ดูภาพหน้าจอ:

doc ส่งผู้รับหลายคน 1

4. จากนั้นคลิก OKและ Outlook ข้อความ หน้าต่างจะปรากฏขึ้นคุณสามารถเห็นที่อยู่อีเมลที่เลือกทั้งหมดได้ถูกเพิ่มลงในไฟล์ ไปยัง จากนั้นคุณสามารถป้อนหัวเรื่องและเขียนข้อความของคุณดูภาพหน้าจอ:

doc ส่งผู้รับหลายคน 2

5. หลังจากจบข้อความโปรดคลิก ส่ง และข้อความนี้จะถูกส่งไปยังผู้รับเหล่านี้ในรายการแผ่นงานของคุณ


ลูกศรสีฟ้าฟองขวา ส่งอีเมลไปยังผู้รับหลายคนพร้อมสมุดงานปัจจุบันเป็นไฟล์แนบโดยใช้รหัส VBA

หากคุณต้องการส่งข้อความถึงผู้รับหลายคนโดยมีสมุดงานปัจจุบันเป็นไฟล์แนบคุณสามารถใช้รหัส VBA ต่อไปนี้

1. กด ALT + F11 คีย์เพื่อเปิด Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง

2. คลิก สิ่งที่ใส่เข้าไป > โมดูลและวางรหัสต่อไปนี้ในไฟล์ หน้าต่างโมดูล.

รหัส VBA: ส่งอีเมลไปยังผู้รับหลายคนพร้อมสมุดงานปัจจุบันเป็นไฟล์แนบ

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. หลังจากวางรหัสแล้วให้กด F5 คีย์เพื่อเรียกใช้รหัสนี้และกล่องพร้อมต์จะปรากฏขึ้นเพื่อเตือนให้คุณเลือกที่อยู่ที่คุณต้องการส่งข้อความดูภาพหน้าจอ:

doc ส่งผู้รับหลายคน 3

4. จากนั้นคลิก OK ปุ่มและ Outlook ข้อความ หน้าต่างจะปรากฏขึ้นมีการเพิ่มที่อยู่อีเมลทั้งหมดลงในไฟล์ ไปยัง และสมุดงานปัจจุบันของคุณถูกแทรกเป็นไฟล์แนบด้วยจากนั้นคุณสามารถป้อนหัวเรื่องและเขียนข้อความของคุณดูภาพหน้าจอ:

doc ส่งผู้รับหลายคน 4

5. จากนั้นคลิก ส่ง เพื่อส่งข้อความนี้ไปยังรายชื่อผู้รับที่มีสมุดงานปัจจุบันเป็นไฟล์แนบ


ส่งอีเมลส่วนตัวไปยังผู้รับหลายคนพร้อมไฟล์แนบที่แตกต่างกัน:

กับ Kutools สำหรับ Excel's ส่งอีเมลล์ คุณสามารถส่งอีเมลส่วนตัวไปยังผู้รับหลาย ๆ คนได้อย่างรวดเร็วด้วยไฟล์แนบที่แตกต่างกันจาก Excel ผ่าน Outlook ตามที่คุณต้องการ ในขณะเดียวกันคุณสามารถ CC หรือ Bcc ข้อความถึงบุคคลใดบุคคลหนึ่งได้เช่นกัน คลิกเพื่อดาวน์โหลด Kutools for Excel!

doc ส่งอีเมลส่วนตัว 18 1


บทความที่เกี่ยวข้อง:

จะส่งอีเมลส่วนบุคคลไปยังรายการจาก Excel ผ่าน Outlook ได้อย่างไร


เครื่องมือเพิ่มประสิทธิภาพการทำงานในสำนักงานที่ดีที่สุด

Kutools สำหรับ Excel ช่วยแก้ปัญหาส่วนใหญ่ของคุณและเพิ่มผลผลิตของคุณได้ถึง 80%

  • นำมาใช้ใหม่: ใส่อย่างรวดเร็ว สูตรที่ซับซ้อนแผนภูมิ และสิ่งที่คุณเคยใช้มาก่อน เข้ารหัสเซลล์ ด้วยรหัสผ่าน; สร้างรายชื่อผู้รับจดหมาย และส่งอีเมล ...
  • ซุปเปอร์ฟอร์มูล่าบาร์ (แก้ไขข้อความและสูตรหลายบรรทัดได้อย่างง่ายดาย); การอ่านเค้าโครง (อ่านและแก้ไขเซลล์จำนวนมากได้อย่างง่ายดาย); วางลงในช่วงที่กรองแล้ว...
  • ผสานเซลล์ / แถว / คอลัมน์ โดยไม่สูญเสียข้อมูล แยกเนื้อหาของเซลล์ รวมแถว / คอลัมน์ที่ซ้ำกัน... ป้องกันเซลล์ซ้ำ; เปรียบเทียบช่วง...
  • เลือกซ้ำหรือไม่ซ้ำ แถว; เลือกแถวว่าง (เซลล์ทั้งหมดว่างเปล่า); Super Find และ Fuzzy Find ในสมุดงานจำนวนมาก สุ่มเลือก ...
  • สำเนาถูกต้อง หลายเซลล์โดยไม่เปลี่ยนการอ้างอิงสูตร สร้างการอ้างอิงอัตโนมัติ ถึงหลายแผ่น ใส่สัญลักษณ์แสดงหัวข้อย่อย, กล่องกาเครื่องหมายและอื่น ๆ ...
  • แยกข้อความ, เพิ่มข้อความ, ลบตามตำแหน่ง, ลบ Space; สร้างและพิมพ์ผลรวมย่อยของเพจ แปลงระหว่างเนื้อหาของเซลล์และความคิดเห็น...
  • ซุปเปอร์ฟิลเตอร์ (บันทึกและใช้โครงร่างตัวกรองกับแผ่นงานอื่น ๆ ); การเรียงลำดับขั้นสูง ตามเดือน / สัปดาห์ / วันความถี่และอื่น ๆ ตัวกรองพิเศษ โดยตัวหนาตัวเอียง ...
  • รวมสมุดงานและแผ่นงาน; ผสานตารางตามคอลัมน์สำคัญ แยกข้อมูลออกเป็นหลายแผ่น; Batch แปลง xls, xlsx และ PDF...
  • คุณสมบัติที่ทรงพลังมากกว่า 300 รายการ. รองรับ Office / Excel 2007-2019 และ 365 รองรับทุกภาษา ใช้งานง่ายในองค์กรหรือองค์กรของคุณ ทดลองใช้ฟรี 30 วันเต็ม รับประกันคืนเงิน 60 วัน
kte แท็บ 201905

แท็บ Office นำอินเทอร์เฟซแบบแท็บมาที่ Office และทำให้งานของคุณง่ายขึ้นมาก

  • เปิดใช้งานการแก้ไขและอ่านแบบแท็บใน Word, Excel, PowerPoint, ผู้จัดพิมพ์, Access, Visio และโครงการ
  • เปิดและสร้างเอกสารหลายรายการในแท็บใหม่ของหน้าต่างเดียวกันแทนที่จะเป็นในหน้าต่างใหม่
  • เพิ่มผลผลิตของคุณ 50% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!
ด้านล่าง officetab
จัดเรียงความคิดเห็นโดย
ความคิดเห็น (20)
ยังไม่มีการให้คะแนน เป็นคนแรกที่ให้คะแนน!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
มันยอดเยี่ยมมาก นี่คือสิ่งที่ฉันต้องการ มีอยู่แล้วเพื่อเพิ่มคุณสมบัติที่คุณสามารถเพิ่มข้อความในหัวเรื่องโดยใช้รหัส.... ฉันไม่ต้องการอะไรในกล่องข้อความ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี รหัส VBA ทำงานได้ดีสำหรับฉัน ขอบคุณ มีวิธีใดบ้างที่ฉันสามารถสร้างเซลล์ด้วยปุ่มที่เรียกป๊อปอัป "เลือกรายชื่อผู้รับจดหมาย" เจค
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ขอบคุณสำหรับรหัส มีวิธีใดบ้างที่ฉันสามารถสร้างปุ่มคำสั่งบน excel จากนั้นโดยการคลิกที่ปุ่มนั้น แผ่นงาน excel เดียวกันจะถูกส่งไปยังผู้รับหลายคนเป็นไฟล์แนบ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันจะทำสิ่งนี้โดยใช้บรรทัด BCC ได้อย่างไร
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี โรเบิร์ต
หลังจากรันโค้ดแล้ว หน้าต่างข้อความใหม่จะเปิดขึ้น คุณเพียงแค่ต้องแทรกบรรทัด BCC ใต้แท็บ ตัวเลือก ดูภาพหน้าจอต่อไปนี้:


หวังว่ามันจะช่วยคุณได้ ขอบคุณ!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
มีวิธีใดบ้างที่จะใช้สิ่งนี้เพื่อส่งจากอีเมลที่แชร์? ฉันไม่สามารถแทรกฟิลด์ .SendOnBehalfOf ได้
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ! ทุกเดือนฉันควรส่งอีเมลเดียวกันสำหรับผู้ให้บริการที่แตกต่างกัน แต่ไม่ควรอยู่ในอีเมลเดียวกัน ..... ฉันจะส่งอีเมลเดียวกันไปยังปลายทางที่แตกต่างกันได้อย่างไรโดยไม่มีใครอยู่ในอีเมลเดียวกัน ?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี วินิซิอุส
หากต้องการส่งอีเมลเดียวกันไปยังผู้รับหลายรายแยกกัน บทความต่อไปนี้สามารถช่วยคุณได้ โปรดดูที่
https://www.extendoffice.com/documents/excel/3560-excel-send-personalized-email.html
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ตอนเช้า


ฉันยังใหม่กับการพยายามเขียนและใช้มาโครใน excel ความพยายามครั้งแรกของฉันคือพยายามสร้างอีเมลย่อยจำนวนมากจากรายการหลักที่มีขนาดใหญ่ ฉันตัดและวางรูทีนแรก จากนั้นพยายามใช้มันทั้งหมดโดยเน้นไปที่เซลล์ที่ฉันขอ ไม่มีการสร้างอีเมล Outlook ฉันทำอะไรผิด หากต้องการขยายความตามจริง ฉันต้องการกำหนดเป้าหมายอีเมลด้วยรหัสไปรษณีย์หรือส่วนย่อยอื่นๆ ฉันจะสร้างมาโครที่จะค้นหาคอลัมน์สำหรับรหัสไปรษณีย์ที่กำหนด และสร้างอีเมลโดยพบผู้รับทั้งหมดได้อย่างไร

ขอขอบคุณ

สตีฟ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันมีรหัสนี้ ปัญหาของฉันคือมันสร้างอีเมลหนึ่งฉบับในแต่ละครั้งที่เงื่อนไขไม่ครบถ้วน แต่ฉันต้องการใส่ข้อมูลทั้งหมดที่ไม่ตรงตามเงื่อนไขในอีเมลฉบับเดียว

ย่อย EnviarCorreo()
Dim OutApp เป็นวัตถุ
Dim OutMail เป็นวัตถุ
Dim lLastRow ตราบใด
หรี่แถวนาน
Dim sSendTo เป็นสตริง
Dim sSendCC เป็นสตริง
Dim sSendBCC เป็นสตริง
Dim sSubject เป็นสตริง
Dim sTemp เป็นสตริง

ตั้งค่า OutApp = CreateObject ("Outlook.Application")
OutApp.Session.Logon

' เปลี่ยนสิ่งต่อไปนี้ได้ตามต้องการ
sSendTo = ""
sSendCC = ""
sSendBCC = ""
sSubject = "ถึงวันที่ครบกำหนด"

ตั้งค่า OutMail = OutApp.CreateItem(0)

lLastRow = เซลล์(Rows.Count, 3).End(xlUp).Row
สำหรับ lRow = 3 ถึง lLastRow
ถ้า Cells(lRow, 9) <> "S" แล้ว
ถ้าเซลล์ (lRow, 2) <= วันที่แล้ว

เกี่ยวกับข้อผิดพลาดต่อไป
ด้วย OutMail
.ถึง = sSendTo
ถ้า sSendCC > "" แล้ว .CC = sSendCC
ถ้า sSendBCC > "" แล้ว .BCC = sSendBCC
.Subject = sเรื่อง

sTemp = "สวัสดี!" & vbCrLf & vbCrLf
sTemp = sTemp & "ถึงวันครบกำหนดแล้ว"
sTemp = sTemp & "สำหรับโครงการนี้:" & vbCrLf & vbCrLf


'นี่คือสิ่งที่ฉันต้องการทำซ้ำในเนื้อหาอีเมล
' ถือว่าชื่อโครงการอยู่ในคอลัมน์ B
sTemp = sTemp & "ID:"
sTemp = sTemp & " " & เซลล์ (lRow, 1)
sTemp = sTemp & " คำอธิบาย: "
sTemp = sTemp & " " & เซลล์ (lRow, 5)
sTemp = sTemp & "โปรดใช้ค่าที่เหมาะสม"
sTemp = sTemp & "การกระทำ" & vbCrLf & vbCrLf
sTemp = sTemp & "ขอบคุณ!" & vbCrLf
จนถึงที่นี่



.Body = อุณหภูมิ
' เปลี่ยนสิ่งต่อไปนี้เป็น .Send หากคุณต้องการ
' ส่งข้อความโดยไม่ตรวจทานก่อน
.แสดง
จบด้วย
ตั้งค่า OutMail = Nothing

เซลล์(lRow, 9) = "S"
Cells(lRow, 10) = "ส่งอีเมลเมื่อ: " & ตอนนี้ ()
End If
End If
ถัดไป lRow
ตั้งค่า OutApp = ไม่มีอะไร
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เป็นไปได้ไหมที่จะแมงดารหัสสำหรับการเลือก CC จากรายการแบบเดียวกับหลังจากเลือก TO ด้วยรหัสที่มีอยู่ จึงไม่สามารถเลือก CC ใด ๆ ได้เช่นเดียวกับข้อกำหนดในการให้บริการ (ที่อยู่หลัก) 
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี Eugen ดีใจที่ได้ช่วย เป็นไปได้ที่จะแมงดารหัสสำหรับการเลือก CC จากรายการในลักษณะเดียวกันหลังจากเลือก TO และโดยพื้นฐานแล้วรหัสก็เหมือนกันกับรหัส TOs VBA ควรทำการเปลี่ยนแปลงเพียงครั้งเดียว เพียงเปลี่ยน ".To = xEmailAddr" เป็น ".Cc = xEmailAddr" โปรดดูภาพหน้าจอ และคุณสามารถเลือก CC และ TO ได้จากรายการพร้อมกัน เพียงสร้าง ".To = xEmailAddr" และ ".Cc = xEmailAddr" ให้รวมอยู่ในโค้ด VBA โปรดวางรหัสต่อไปนี้ในหน้าต่างโมดูล
ย่อย sendmultiple()
'updateby Extendoffice
Dim xOTApp เป็นวัตถุ
Dim xMItem เป็นวัตถุ
Dim xCell เป็นช่วง
Dim xRg เป็นช่วง
Dim xEmailAddr เป็นสตริง
Dim xTxt เป็นสตริง
เกี่ยวกับข้อผิดพลาดต่อไป
xTxt = ActiveWindow.RangeSelection.Address
Set xRg = Application.InputBox("โปรดเลือกรายการที่อยู่:", "Kutools สำหรับ Excel", xTxt, , , , , 8)
ถ้า xRg ไม่มีอะไร ให้ออกจาก Sub
ตั้งค่า xOTApp = CreateObject("Outlook.Application")
สำหรับแต่ละ xCell ใน xRg
ถ้า xCell.Value ชอบ "*@*" แล้ว
ถ้า xEmailAddr = "" แล้ว
xEmailAddr = xCell.Value
อื่น
xEmailAddr = xEmailAddr & ";" & xCell.Value
End If
End If
ต่อไป
ตั้งค่า xMItem = xOTApp.CreateItem(0)
ด้วย xMitem
.ถึง = xEmailAddr
.Cc = xEmailAddr
.แสดง
จบด้วย
ย่อยสิ้นสุด

หวังว่าจะสามารถแก้ปัญหาของคุณได้ มีวันที่ดี. ขอแสดงความนับถือ Mandy
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันกำลังพยายามให้ excel ส่งอีเมลไปยังผู้รับหลายคนและสามารถรับทุกอย่างที่ฉันต้องการได้ แต่ปฏิเสธที่จะใส่ที่อยู่อีเมลในกล่องถึง นี่คือรหัสที่ฉันใช้อยู่ ใครสามารถช่วยฉันหาสิ่งที่ฉันทำผิด? ขอบคุณมาก!

ย่อย Macro1()
Dim rngCell เป็นช่วง
หรี่ rngMyDataSet เป็นช่วง
Dim Rng เป็นช่วง
Dim OutApp เป็นวัตถุ
Dim OutMail เป็นวัตถุ
Dim EmailSubject เป็นสตริง
Dim EmailSendTo เป็นสตริง
Dim MailBody เป็นสตริง
Dim EmailRecipient เป็นช่วง
ลายเซ็นติ่มซำเป็นสตริง
Application.ScreenUpdating = เท็จ
ด้วย ActiveSheet
ถ้า .FilterMode แล้ว .ShowAllData
ตั้งค่า Rng = .Range("AK6", .Cells(.Rows.Count, 1).End(xlUp))
จบด้วย
สำหรับแต่ละ rngCell ใน Rng
ถ้า rngCell.Offset(0, 6) > 0 แล้ว

ElseIf rngCell.Offset(0, 5) > ประเมิน ("วันนี้ () +7") และ _
rngCell.Offset(0, 5).Value <= Evaluate("Today() +30") จากนั้น
rngCell.Offset(0, 6).Value = วันที่

ตั้งค่า OutApp = CreateObject ("Outlook.Application")
ตั้งค่า OutMail = OutApp.CreateItem(0)

strbody = "ตามบันทึกของฉัน สัญญาของคุณ " & Range("A6") ค่า & " ครบกำหนดสำหรับการตรวจสอบใน " & rngCell.Offset(0, 5).Value & vbNewLine & _
"โปรดตรวจสอบสัญญานี้ก่อนถึงวันที่เกี่ยวข้อง และส่งอีเมลถึงฉันเกี่ยวกับการเปลี่ยนแปลงใดๆ ที่คุณทำกับสัญญานี้ หากมีการต่ออายุ โปรดกรอกใบปะหน้าสัญญาซึ่งสามารถพบได้ในโฟลเดอร์ Everyone และส่งสัญญาฉบับใหม่มาให้ฉัน "
EmailSendTo = rngCell.Offset(0, 0).ค่า
EmailSubject = Sheets("sheet1")).Range("A6")).Value
ลายเซ็น = "C:\Documents and Settings\" & Environ("rmm") & _
"\Application Data\Microsoft\Signatures\rm.htm"
เกี่ยวกับข้อผิดพลาดต่อไป
ด้วย OutMail
.ถึง = EmailSendTo
.CC = "hhh@gmail.com"
.BCC = ""
.Subject = อีเมลเรื่อง
.Body = สตรอง
.แสดง
Send_Value = Mail_Recipient.Offset(i - 1).Value
จบด้วย
เมื่อเกิดข้อผิดพลาด GoTo 0
ตั้งค่า OutMail = Nothing
ตั้งค่า OutApp = ไม่มีอะไร

End If

ถัดไป rngCell
Application.ScreenUpdating = จริง
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีไดอาน่า
บางทีคุณสามารถใช้รหัสด้านล่าง:

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).ค่าคุณควรเปลี่ยนหมายเลข 2 และ 6 เป็นหมายเลขแถวและคอลัมน์ตามช่วงข้อมูลของคุณ ช่วงนี้มีที่อยู่อีเมลที่คุณต้องการส่งไป

โปรดลอง หวังว่าจะช่วยคุณได้!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอบคุณ แต่น่าเสียดายที่มันไม่ได้ผล ฉันยังคงได้รับผลลัพธ์เดียวกัน
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีไดอาน่า
ในกรณีนี้ โปรดระบุภาพหน้าจอหรือไฟล์แนบของข้อมูลในเวิร์กชีต เพื่อให้เราสามารถระบุได้ว่าปัญหาอยู่ที่ใด
หรือคุณสามารถอธิบายปัญหาของคุณให้ชัดเจนและมีรายละเอียดมากขึ้น
ขอขอบคุณ!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ด้านล่างนี้คือรหัสปัจจุบันที่ฉันใช้อยู่ แต่จะไม่ใส่ที่อยู่อีเมลแต่ละรายการในช่องถึง แต่จะระบุที่อยู่อีเมลแรกในกล่องทั้งหมดเท่านั้น ก็ทำสิ่งเดียวกันกับ SUBJECT และในข้อความอีเมล มันก็แค่ใช้สิ่งเดิมซ้ำแล้วซ้ำเล่า ฉันไม่แน่ใจว่าจะแนบสเปรดชีตกับอีเมลนี้ได้อย่างไร

ย่อย Macro1()
Dim rngCell เป็นช่วง
หรี่ rngMyDataSet เป็นช่วง
Dim Rng เป็นช่วง
Dim OutApp เป็นวัตถุ
Dim OutMail เป็นวัตถุ
Dim EmailSubject เป็นสตริง
Dim EmailSendTo เป็นสตริง
Dim MailBody เป็นช่วง
Dim EmailRecipient เป็นช่วง
ลายเซ็นติ่มซำเป็นสตริง
Application.ScreenUpdating = เท็จ
ด้วย ActiveSheet
ถ้า .FilterMode แล้ว .ShowAllData
ตั้งค่า Rng = .Range("AJ6", .Cells(.Rows.Count, 1).End(xlUp))
จบด้วย
สำหรับแต่ละ rngCell ใน Rng
ถ้า rngCell.Offset(0, 6) > 0 แล้ว

ElseIf rngCell.Offset(0, 5) > ประเมิน ("วันนี้ () +7") และ _
rngCell.Offset(0, 5).Value <= Evaluate("Today() +120") จากนั้น
rngCell.Offset(0, 6).Value = วันที่

ตั้งค่า OutApp = CreateObject ("Outlook.Application")
ตั้งค่า OutMail = OutApp.CreateItem(0)

strbody = "ตามบันทึกของฉัน" & Range("A6")).Value & " contract is due for review " & rngCell.Offset(0, 5).Value & _
" เป็นสิ่งสำคัญที่คุณต้องตรวจสอบสัญญานี้โดยเร็วและส่งอีเมลถึงฉันด้วยการเปลี่ยนแปลงใด ๆ หากมีการต่ออายุ โปรดกรอกใบปะหน้าสัญญาซึ่งสามารถพบได้ในโฟลเดอร์ทุกคนและส่งใบปะหน้าพร้อมกับสัญญาฉบับใหม่มาให้ฉัน ."
EmailSendTo = Sheets("sheet1")).Range("AJ6")).Value
EmailSubject = Sheets("sheet1")).Range("A6")).Value
ลายเซ็น = "C:\Documents and Settings\" & Environ("rmm") & _
"\Application Data\Microsoft\Signatures\rm.htm"
เกี่ยวกับข้อผิดพลาดต่อไป
ด้วย OutMail
.ถึง = EmailSendTo
.CC = "hhh@gmail.com"
.BCC = ""
.Subject = อีเมลเรื่อง
.Body = สตรอง
.แสดง
Send_Value = Mail_Recipient.Offset(i - 1).Value
จบด้วย
เมื่อเกิดข้อผิดพลาด GoTo 0
ตั้งค่า OutMail = Nothing
ตั้งค่า OutApp = ไม่มีอะไร

End If

ถัดไป rngCell
Application.ScreenUpdating = จริง
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี,
คุณสามารถแทรกสมุดงานของคุณเป็นสิ่งที่แนบมาได้ที่นี่ โปรดดูภาพหน้าจอด้านล่าง:
https://www.extendoffice.com/images/stories/comments/comment-skyyang/doc-attachment-1.png
ขอขอบคุณ!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ไม่มีกล่อง "อัปโหลดไฟล์แนบ" ที่ส่วนท้ายของฉัน
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีไดอาน่า
หากไม่มีกล่อง "อัปโหลดไฟล์แนบ" คุณควรลงทะเบียนก่อน จากนั้นตัวเลือก "อัปโหลดไฟล์แนบ" จะปรากฏขึ้น
หากต้องการลงทะเบียน โปรดไปที่ด้านบนของบทความแล้วคลิก ลงทะเบียน เพื่อเริ่มต้น
https://www.extendoffice.com/images/stories/comments/comment-skyyang/doc-register.png
ฉันขอโทษสำหรับความไม่สะดวก.
มีความคิดเห็นยังไม่มีการโพสต์ที่นี่
แสดงความคิดเห็นของคุณ
โพสต์ในฐานะแขก
×
ให้คะแนนโพสต์นี้:
0   ตัวอักษร
สถานที่แนะนำ