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

วิธีแทรกลายเซ็น Outlook เมื่อส่งอีเมลใน Excel

สมมติว่าคุณต้องการส่งอีเมลโดยตรงใน Excel คุณจะเพิ่มลายเซ็น Outlook เริ่มต้นในอีเมลได้อย่างไร บทความนี้มีสองวิธีที่จะช่วยคุณเพิ่มลายเซ็น Outlook เมื่อส่งอีเมลใน Excel

แทรกลายเซ็นลงในอีเมล Outlook เมื่อส่งโดย Excel VBA
แทรกลายเซ็น Outlook ได้อย่างง่ายดายเมื่อส่งอีเมลใน Excel ด้วยเครื่องมือที่น่าทึ่ง

บทช่วยสอนเพิ่มเติมสำหรับการส่งจดหมายใน Excel ...


แทรกลายเซ็นลงในอีเมล Outlook เมื่อส่งโดย Excel VBA

ตัวอย่างเช่น มีรายชื่อที่อยู่อีเมลในเวิร์กชีต เพื่อส่งอีเมลไปยังที่อยู่เหล่านี้ทั้งหมดใน Excel และเพิ่มลายเซ็น Outlook เริ่มต้นในอีเมล โปรดใช้รหัส VBA ด้านล่างเพื่อให้บรรลุ

1. เปิดแผ่นงานที่มีรายการที่อยู่อีเมลที่คุณต้องการส่งอีเมลถึงจากนั้นกดปุ่ม อื่น ๆ + F11 กุญแจ

2. ในการเปิด Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่างคลิก สิ่งที่ใส่เข้าไป > โมดูล, จากนั้นคัดลอกด้านล่าง VBA2 ในหน้าต่างรหัสโมดูล

3. ตอนนี้คุณต้องเปลี่ยนไฟล์ .ร่างกาย เข้าแถว VBA2 ด้วยรหัสใน VBA1. หลังจากนั้นให้ย้ายเส้น .แสดง ใต้เส้น ด้วย xMailOut.

VBA 1: เทมเพลตการส่งอีเมลพร้อมลายเซ็นเริ่มต้นของ Outlook ใน Excel

.HTMLBody = "This is a test email sending in Excel" & "<br>" & .HTMLBody

VBA 2: ส่งอีเมลไปยังที่อยู่อีเมลที่ระบุในเซลล์ใน Excel

Sub SendEmailToAddressInCells()
    Dim xRg As Range
    Dim xRgEach As Range
    Dim xRgVal As String
    Dim xAddress As String
    Dim xOutApp As Outlook.Application
    Dim xMailOut As Outlook.MailItem
    On Error Resume Next
    xAddress = ActiveWindow.RangeSelection.Address
    Set xRg = Application.InputBox("Please select email address range", "KuTools For Excel", xAddress, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    Application.ScreenUpdating = False
    Set xOutApp = CreateObject("Outlook.Application")
    Set xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
    For Each xRgEach In xRg
        xRgVal = xRgEach.Value
        If xRgVal Like "?*@?*.?*" Then
            Set xMailOut = xOutApp.CreateItem(olMailItem)
            With xMailOut
                .To = xRgVal
                .Subject = "Test"
                .Body = "Dear " _
                      & vbNewLine & vbNewLine & _
                        "This is a test email " & _
                        "sending in Excel"
                .Display
                '.Send
            End With
        End If
    Next
    Set xMailOut = Nothing
    Set xOutApp = Nothing
    Application.ScreenUpdating = True
End Sub

ภาพหน้าจอต่อไปนี้สามารถช่วยให้คุณพบความแตกต่างได้อย่างง่ายดายหลังจากเปลี่ยนรหัส VBA

4 กด F5 กุญแจสำคัญในการเรียกใช้รหัส จากนั้นก Kutools สำหรับ Excel เลือกกล่องปรากฏขึ้นโปรดเลือกที่อยู่อีเมลที่คุณจะส่งอีเมลไปให้จากนั้นคลิก ตกลง

จากนั้นอีเมลจะถูกสร้างขึ้น คุณสามารถดูลายเซ็นเริ่มต้นของ Outlook ได้ที่ส่วนท้ายของเนื้อหาอีเมล

ทิปส์:

  • 1. คุณสามารถเปลี่ยนเนื้อหาอีเมลในรหัส VBA 1 ตามความต้องการของคุณ
  • 2. หลังจากรันโค้ดแล้วหากกล่องโต้ตอบข้อผิดพลาดปรากฏขึ้นเตือนว่าไม่ได้กำหนดประเภทที่ผู้ใช้กำหนดโปรดปิดกล่องโต้ตอบนี้จากนั้นไปที่คลิก เครื่องมือ > อ้างอิง ใน Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง. ในการเปิด เอกสารอ้างอิง - VBAProject ตรวจสอบหน้าต่าง ไลบรารีวัตถุของ Microsoft Outlook แล้วคลิก ตกลง จากนั้นเรียกใช้รหัสอีกครั้ง

แทรกลายเซ็น Outlook ได้อย่างง่ายดายเมื่อส่งอีเมลใน Excel ด้วยเครื่องมือที่น่าทึ่ง

หากคุณเป็นมือใหม่ใน VBA ขอแนะนำไฟล์ ส่งอีเมลล์ ประโยชน์ของ Kutools สำหรับ Excel สำหรับคุณ. ด้วยคุณสมบัตินี้คุณสามารถส่งอีเมลโดยอิงตามช่องบางช่องใน Excel และเพิ่มลายเซ็น Outlook ให้ได้อย่างง่ายดาย กรุณาดำเนินการดังนี้

ก่อนที่จะใช้ Kutools สำหรับ Excelโปรด ดาวน์โหลดและติดตั้งในตอนแรก.

ประการแรกคุณต้องสร้างรายชื่ออีเมลที่มีช่องต่างๆที่คุณจะส่งอีเมลตาม

คุณสามารถสร้างรายชื่อส่งเมลด้วยตนเองได้ตามต้องการหรือใช้คุณสมบัติสร้างรายชื่อเมลเพื่อทำให้เสร็จอย่างรวดเร็ว

1 คลิก Kutools พลัส > สร้างรายชื่อผู้รับจดหมาย

2 ใน สร้างรายชื่อผู้รับจดหมาย กล่องโต้ตอบระบุฟิลด์ที่คุณต้องการเลือกตำแหน่งที่จะแสดงรายการจากนั้นคลิกไฟล์ OK ปุ่ม

3. ตอนนี้ตัวอย่างรายชื่อผู้รับจดหมายถูกสร้างขึ้น เนื่องจากเป็นรายการตัวอย่างคุณจึงต้องเปลี่ยนฟิลด์เป็นเนื้อหาที่จำเป็นบางอย่าง (อนุญาตให้มีหลายแถว)

4. หลังจากนั้นเลือกรายการทั้งหมด (รวมส่วนหัว) คลิก Kutools พลัส > ส่งอีเมลล์.

5 ใน ส่งอีเมลล์ กล่องโต้ตอบ:

  • 5.1) รายการในรายชื่อผู้รับจดหมายที่เลือกจะถูกวางในช่องที่เกี่ยวข้องโดยอัตโนมัติ
  • 5.2) เสร็จสิ้นเนื้อหาอีเมล
  • 5.3) ตรวจสอบทั้ง ส่งอีเมลผ่าน Outlook และ ใช้การตั้งค่าลายเซ็นของ Outlook กล่อง;
  • 5.4) คลิกปุ่ม ส่ง ปุ่ม. ดูภาพหน้าจอ:

ตอนนี้อีเมลถูกส่ง และลายเซ็น Outlook เริ่มต้นจะถูกเพิ่มที่ส่วนท้ายของเนื้อหาอีเมล

  หากคุณต้องการทดลองใช้ยูทิลิตีนี้ฟรี (30 วัน) กรุณาคลิกเพื่อดาวน์โหลดแล้วไปใช้การดำเนินการตามขั้นตอนข้างต้น


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

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

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

ส่งอีเมลพร้อมไฟล์แนบหลายไฟล์แนบใน Excel
บทความนี้พูดถึงการส่งอีเมลผ่าน Outlook พร้อมแนบไฟล์แนบหลายไฟล์ใน Excel

ส่งอีเมลหากตรงตามวันที่ครบกำหนดใน Excel
ตัวอย่างเช่นหากวันที่ครบกำหนดในคอลัมน์ C น้อยกว่าหรือเท่ากับ 7 วัน (วันที่ปัจจุบันคือ 2017/9/13) ให้ส่งการแจ้งเตือนทางอีเมลไปยังผู้รับที่ระบุในคอลัมน์ A พร้อมเนื้อหาที่ระบุในคอลัมน์ B วิธีการ บรรลุเป้าหมาย? บทความนี้จะให้รายละเอียดเกี่ยวกับวิธีการ VBA เพื่อจัดการกับมัน

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

บทช่วยสอนเพิ่มเติมสำหรับการส่งจดหมายใน Excel ...


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

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
จัดเรียงความคิดเห็นโดย
ความคิดเห็น (27)
ยังไม่มีการให้คะแนน เป็นคนแรกที่ให้คะแนน!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอบคุณมาก คุณช่วยชีวิตฉันด้วยเทมเพลตนี้ :D
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เรียนคุณฟาวิโอ
ดีใจที่ได้ช่วยเหลือ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ไม่ทำงานกับไฟล์แนบใน Office 2016
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เรียนคริส
รหัส VBA ด้านล่างสามารถช่วยคุณได้ หลังจากเรียกใช้โค้ดแล้ว โปรดเลือกเซลล์ที่มีที่อยู่อีเมลที่คุณจะส่งอีเมลไป จากนั้นเลือกไฟล์ที่คุณต้องการแนบในอีเมลเป็นไฟล์แนบเมื่อกล่องโต้ตอบที่สองปรากฏขึ้น และลายเซ็น Outlook เริ่มต้นจะแสดงในเนื้อหาอีเมลด้วย ขอบคุณสำหรับความคิดเห็นของคุณ.

ย่อย SendEmailToAddressInCells()
Dim xRg เป็นช่วง
Dim xRgEach เป็นช่วง
Dim xRgVal เป็นสตริง
Dim xAddress เป็นสตริง
Dim xOutApp เป็น Outlook.Application
Dim xMailOut เป็น Outlook.MailItem
เกี่ยวกับข้อผิดพลาดต่อไป
xAddress = ActiveWindow.RangeSelection.Address
ตั้งค่า xRg = Application.InputBox("โปรดเลือกช่วงที่อยู่อีเมล", "KuTools For Excel", xAddress, , , , , 8)
ถ้า xRg ไม่มีอะไร ให้ออกจาก Sub
Application.ScreenUpdating = เท็จ
ตั้งค่า xOutApp = CreateObject("Outlook.Application")
ตั้งค่า xRg = xRg.SpecialCells(xlCellTypeConstants, xlTextValues)
ตั้งค่า xFileDlg = Application.FileDialog(msoFileDialogFilePicker)
ถ้า xFileDlg.Show = -1 แล้ว
สำหรับแต่ละ xRgEach ใน xRg
xRgVal = xRgEach.Value
ถ้า xRgVal ชอบ "?*@?*.?*" แล้ว
ตั้งค่า xMailOut = xOutApp.CreateItem(olMailItem)
ด้วย xMailOut
.แสดง
.ถึง = xRgVal
.Subject = "ทดสอบ"
.HTMLBody = "นี่คือการส่งอีเมลทดสอบใน Excel" & "
" & .HTMLBody
สำหรับแต่ละ xFileDlgItem ใน xFileDlg.SelectedItems
.Attachments.Add xFileDlgItem
xFileDlgItem . ถัดไป
'.ส่ง
จบด้วย
End If
ต่อไป
ตั้งค่า xMailOut = ไม่มีอะไร
ตั้งค่า xOutApp = Nothing
Application.ScreenUpdating = จริง
End If
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันกำลังพยายามเพิ่มลายเซ็น Outlook ที่ชื่อว่า "ค่าเริ่มต้น" แต่ดูเหมือนจะไม่สามารถใช้งานได้
คุณช่วยได้ไหม ฉันเชื่อว่าตรรกะ "xMailout" ของฉันไม่ถูกต้อง นี่คือพื้นที่ที่สงสัยว่าผิดพลาดของฉัน

คำสั่งย่อยส่วนตัวButton1_Click()

Dim xOutApp เป็นวัตถุ
Dim xOutMail เป็นวัตถุ
Dim xMailBody เป็นสตริง
Dim xMailOut เป็น Outlook.MailItem
เกี่ยวกับข้อผิดพลาดต่อไป
ตั้งค่า xOutApp = CreateObject("Outlook.Application")
ตั้งค่า xOutMail = xOutApp.CreateItem(0)
xMailBody = "สวัสดี:" & vbNewLine & vbNewLine & _
"นี่คือบรรทัดที่ 1" & vbNewLine & _
"นี่คือบรรทัดที่ 2" & vbNewLine & _
"นี่คือบรรทัดที่ 3" & vbNewLine & _
“นี่คือบรรทัดที่ 4”
เกี่ยวกับข้อผิดพลาดต่อไป
ด้วย xOutMail
.To = "Email.here.com"
.CC = "Email.here.com"
.Subject = "อีเมลชื่อที่นี่ - " & ช่วง ("Cell#") .value
.Body = xMailBody
. ไฟล์แนบเพิ่ม ActiveWorkbook.FullName
ตั้งค่า xMailOut = xOutApp.CreateItem(olMailItem)
ด้วย xMailOut
.แสดง
จบด้วย
ActiveWorkbook บันทึก
เมื่อเกิดข้อผิดพลาด GoTo 0
ตั้งค่า xOutMail = Nothing
ตั้งค่า xOutApp = Nothing
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
วันดี,
สคริปต์ของคุณได้รับการแก้ไข โปรดลอง ขอขอบคุณ.

คำสั่งย่อยส่วนตัวButton1_Click()
Dim xOutApp เป็นวัตถุ
Dim xOutMail เป็นวัตถุ
Dim xMailBody เป็นสตริง
Dim xMailOut เป็น Outlook.MailItem
เกี่ยวกับข้อผิดพลาดต่อไป
ตั้งค่า xOutApp = CreateObject("Outlook.Application")
ตั้งค่า xOutMail = xOutApp.CreateItem(0)
xMailBody = "สวัสดี:" & vbNewLine & vbNewLine & _
"นี่คือบรรทัดที่ 1" & vbNewLine & _
"นี่คือบรรทัดที่ 2" & vbNewLine & _
"นี่คือบรรทัดที่ 3" & vbNewLine & _
“นี่คือบรรทัดที่ 4”
เกี่ยวกับข้อผิดพลาดต่อไป
ด้วย xOutMail
.To = "Email.here.com"
.CC = "Email.here.com"
.Subject = "อีเมลชื่อที่นี่ - " & ช่วง ("Cell#") .Value
.Body = xMailBody
.Attachments.Add ActiveWorkbook.FullName
ตั้งค่า xMailOut = xOutApp.CreateItem(olMailItem)
ด้วย xMailOut
.แสดง
จบด้วย
จบด้วย
ActiveWorkbook บันทึก
เมื่อเกิดข้อผิดพลาด GoTo 0
ตั้งค่า xOutMail = Nothing
ตั้งค่า xOutApp = Nothing
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
วิธีเพิ่มลายเซ็นหากผู้ใช้หลายคนใช้มาโคร
เช่นมาโครของฉันจะถูกเรียกใช้โดยบุคคลอื่น 3 คนเช่นกัน ดังนั้นมาโครจะใช้ลายเซ็นของผู้ใช้ที่กำลังเรียกใช้แมโครได้อย่างไร
ขอบคุณล่วงหน้า
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอให้เป็นวันที่ดี,
รหัส VBA สามารถจดจำลายเซ็นเริ่มต้นใน Outlook ของผู้ส่งได้โดยอัตโนมัติ และส่งอีเมลพร้อมลายเซ็นของเขาเองผ่าน Outlook
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
หากข้อความเนื้อหาของฉันถูกลิงก์เพื่อดึงจากฟิลด์ excel การใช้ & .HTMLBody ที่ส่วนท้ายของสตริงจะลบข้อความเนื้อหาทั้งหมดและทิ้งลายเซ็นไว้
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันมีปัญหาในการใช้งาน excel 2016 ฉันได้รับข้อความ "ข้อผิดพลาดในการคอมไพล์: User Defined Type Not Defined" กรุณาช่วย!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สุดยอด!!!!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอบคุณมาก...
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ฉันต้องการความช่วยเหลือเกี่ยวกับมาโคร ฉันต้องการแทรกลายเซ็น Outlook ใต้ตาราง คุณช่วยได้ไหม

คำสั่งย่อยส่วนตัวButton1_Click()


มุมมองที่มืดมนเป็นวัตถุ
ติ่มซำใหม่Email As Object
Dim xInspect เป็นวัตถุ
Dim pageEditor เป็นวัตถุ

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

ด้วยอีเมลใหม่
.To = Sheet5.Range("F1")
.CC = ""
.BCC = ""
.Subject = Sheet5.Range("B5")
.Body = Sheet5.Range("B41")
.แสดง

ตั้งค่า xInspect = newEmail.GetInspector
ตั้งค่า pageEditor = xInspect.WordEditor

Sheet5.Range("B6:I7") คัดลอก

pageEditor.Application.Selection.Start = Len(.Body)
pageEditor.Application.Selection.End = pageEditor.Application.Selection.Start
pageEditor.Application.Selection.PasteAndFormat (wdFormatPlainText)

.แสดง
ตั้งค่า pageEditor = Nothing
ตั้งค่า xInspect = Nothing
จบด้วย

ตั้งค่าอีเมลใหม่ = ไม่มีอะไร
กำหนดแนวโน้ม = ไม่มีอะไร

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


ย่อย Helloworld()
Dim OutApp เป็นวัตถุ
Dim OutMail เป็นวัตถุ
เซลล์หรี่เป็นช่วง
เส้นทางมืดเป็นสตริง
เส้นทาง = Application.ActiveWorkbook.Path
ตั้งค่า OutApp = CreateObject ("Outlook.Application")

สำหรับแต่ละเซลล์ในช่วง ("C4:C6")
ตั้งค่า OutMail = OutApp.CreateItem(0)
ด้วย OutMail
.แสดง
.To = เซลล์.Value
.Subject = เซลล์(cell.Row, "D")).Value
.HTMLBody = "เรียน " & เซลล์(cell.Row, "B")).Value & "," _
& vbNewLine & vbNewLine & _
"ทักทายอย่างอบอุ่น" _
& vbNewLine & vbNewLine & _
“พวกเรา JK Overseas ขอถือโอกาสแนะนำบริษัทของเรา JK Overseas ซึ่งเกี่ยวข้องกับธุรกิจเกลือมาเป็นเวลา 3 ปีแล้ว ขณะนี้เรามีความแข็งแกร่งทั้งในประเทศและขยายธุรกิจไปยังต่างประเทศ เราคือผู้จำหน่ายเกลือบริโภค เกลือละลายน้ำ เกลือละลายน้ำแข็ง เกลืออุตสาหกรรม" & "" _
& vbNewLine & vbNewLine & _
"เรามีความสัมพันธ์กับผู้ผลิตรายใหญ่ในอินเดียและจัดหาเกลือและการส่งออกที่มีคุณภาพจากพวกเขา ดังนั้นเราจึงมองหาผู้นำเข้าผู้เชี่ยวชาญที่เชื่อถือได้รวมถึงตัวแทนผู้จัดจำหน่ายเพื่อทำธุรกิจระยะยาวด้วยผลประโยชน์ร่วมกัน" & " ." _
& vbNewLine & vbNewLine & _
"โปรดติดต่อเราเพื่อแจ้งความต้องการของคุณหรือสอบถามข้อมูลเพิ่มเติม เราให้บริการด้านลอจิสติกส์ที่เชื่อถือได้และจัดส่งตรงเวลา เรามั่นใจว่าราคาของเราที่แข่งขันได้มากที่สุดจะตรงกับความคาดหวังของคุณ" & "" _
& vbNewLine & vbNewLine & _
.HTMLเนื้อหา

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

CheckAndSendMail() ย่อยสาธารณะ

'ปรับปรุงโดย Extendoffice 2018 / 11 / 22

Dim xRgDate เป็นช่วง

Dim xRgSend เป็นช่วง

Dim xRgText เป็นช่วง

Dim xRgDone เป็นช่วง

Dim xOutApp เป็นวัตถุ

Dim xMailItem เป็นวัตถุ

Dim xLastRow ตราบใดที่

Dim vbCrLf เป็นสตริง

Dim xMailBody เป็นสตริง

Dim xRgDateVal เป็นสตริง

Dim xRgSendVal เป็นสตริง

Dim xMailSubject เป็นสตริง

หรี่ฉันนาน

เกี่ยวกับข้อผิดพลาดต่อไป

'โปรดระบุช่วงวันที่ครบกำหนด

xStrRang = "D2:D110"

ตั้งค่า xRgDate = ช่วง (xStrRang)

'โปรดระบุช่วงที่อยู่อีเมลของผู้รับ

xStrRang = "C2:C110"

ตั้งค่า xRgSend = ช่วง (xStrRang)

xStrRang = "A2:A110"

ตั้งค่า xRgName = ช่วง (xStrRang)

'ระบุช่วงด้วยเนื้อหาเตือนความจำในอีเมลของคุณ

xStrRang = "Z2:Z110"

ตั้งค่า xRgText = ช่วง (xStrRang)

xLastRow = xRgDate.Rows.Count

ตั้งค่า xRgDate = xRgDate(1)

ตั้งค่า xRgSend = xRgSend(1)

ตั้งค่า xRgName = xRgName(1)

ตั้งค่า xRgText = xRgText(1)

ตั้งค่า xOutApp = CreateObject("Outlook.Application")

สำหรับฉัน = 1 ถึง xLastRow

xRgDateVal = ""

xRgDateVal = xRgDate.Offset(I - 1).Value

ถ้า xRgDateVal <> "" แล้ว

ถ้า CDate(xRgDateVal) - วันที่ <= 30 และ CDate(xRgDateVal) - วันที่ > 0 จากนั้น

xRgSendVal = xRgSend.Offset(I - 1).Value

xMailSubject = " ข้อตกลงการบริการ JBC กำลังจะหมดอายุในวันที่ " & xRgDateVal

vbCrLf = "

"

xMailBody = ""

xMailBody = xMailBody & "เรียน" & xRgName.Offset (I - 1).Value & vbCrLf

xMailBody = xMailBody & " " & xRgText.Offset(I - 1).Value & vbCrLf

xMailBody = xMailBody & ""

ตั้งค่า xMailItem = xOutApp.CreateItem(0)

ด้วย xMailItem

.Subject = xMailSubject

.ถึง = xRgSendVal

.CC = "mailcc@justbettercare.com"

.HTMLBody = xMailBody

.แสดง

'.ส่ง

จบด้วย

ตั้งค่า xMailItem = Nothing

End If

End If

ต่อไป

ตั้งค่า xOutApp = Nothing

ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
เป็นโค้ดที่มีประโยชน์มาก
ฉันต้องเปลี่ยนรูปแบบข้อความจากขวาไปซ้ายในบรรทัด xOutMsg
ช่วยด้วย .
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันกำลังพยายามส่งแผ่นงานแต่ละแผ่นจาก excel ไปยังอีเมลอื่น แต่จะแนบเฉพาะสมุดงานเท่านั้น ยังต้องสามารถเพิ่มลายเซ็นของฉันเข้าไปได้ ช่วยอะไรได้บ้าง Sub AST_Email_From_Excel()

Dim emailApplication เป็นวัตถุ
Dim emailItem เป็นวัตถุ

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

' ตอนนี้เราสร้างอีเมล

emailItem.to = Range("e2") .Value

emailItem.CC = ช่วง ("g2") .Value

emailItem.Subject = "อุปกรณ์ทดสอบด้านเทคนิคที่ไม่ได้ส่งคืน"

emailItem.Body = "ดูสเปรดชีตที่แนบมาสำหรับรายการที่ยังไม่ได้ส่งคืนในพื้นที่ของคุณ"

'แนบสมุดงานปัจจุบัน
emailItem.Attachments.Add ActiveWorkbook.FullName

'แนบไฟล์ใดก็ได้จากคอมพิวเตอร์ของคุณ
'emailItem.Attachments.Add ("C:\...)"

'ส่งอีเมล
'emailItem.send

'แสดงอีเมลเพื่อให้ผู้ใช้สามารถเปลี่ยนแปลงได้ตามต้องการก่อนส่ง
emailItem.Display

ตั้งค่า emailItem = Nothing
ตั้งค่า emailApplication = Nothing

ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีคริส รหัสที่คุณให้ไว้ได้รับการแก้ไขแล้ว ขณะนี้สามารถแทรกลายเซ็น Outlook ลงในเนื้อหาข้อความได้แล้ว กรุณาให้มันลอง ขอขอบคุณ. ย่อย AST_Email_From_Excel()
'ปรับปรุงโดย Extendoffice 20220211
Dim emailApplication เป็นวัตถุ
Dim emailItem เป็นวัตถุ
ตั้งค่า emailApplication = CreateObject("Outlook.Application")
ตั้งค่า emailItem = emailApplication.CreateItem(0)

' ตอนนี้เราสร้างอีเมล
emailItem.Display 'แสดงอีเมลเพื่อให้ผู้ใช้สามารถเปลี่ยนแปลงได้ตามต้องการก่อนส่ง
emailItem.to = Range("e2") .Value
emailItem.CC = ช่วง ("g2") .Value
emailItem.Subject = "อุปกรณ์ทดสอบด้านเทคนิคที่ไม่ได้ส่งคืน"
emailItem.HTMLBody = "ดูสเปรดชีตที่แนบมาสำหรับรายการที่ยังไม่ได้ส่งคืนในพื้นที่ของคุณ" & " " & emailItem.HTMLBody

'แนบสมุดงานปัจจุบัน
emailItem.Attachments.Add ActiveWorkbook.FullName

ตั้งค่า emailItem = Nothing
ตั้งค่า emailApplication = Nothing

ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี Crystal ขอบคุณที่เพิ่มลายเซ็น ดูเหมือนจะไม่ชอบส่วน HTMLBody เลย เมื่อฉันเรียกใช้แมโคร มันจะดีบักใน emailItem.HTMLBody = "ดูสเปรดชีตที่แนบมาสำหรับรายการที่ยังไม่ได้ส่งคืนในพื้นที่ของคุณ" & " " & emailItem.HTMLBody และไม่ได้ทำส่วนที่เหลือ  
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี
คุณใช้ Excel เวอร์ชันใดอยู่ รหัส VBA ต่อไปนี้สามารถช่วยได้เช่นกัน กรุณาให้มันลอง ขอบคุณสำหรับความคิดเห็นของคุณ ย่อย SendWorkSheet()
'อัพเดทโดย Extendoffice 20220218
Dim xFile เป็นสตริง
Dim xFormat ตราบเท่าที่
Dim Wb เป็นสมุดงาน
Dim Wb2 เป็นสมุดงาน
Dim FilePath เป็นสตริง
หรี่ชื่อไฟล์เป็นสตริง
หรี่ OutlookApp เป็นวัตถุ
หรี่ OutlookMail เป็นวัตถุ
เกี่ยวกับข้อผิดพลาดต่อไป
Application.ScreenUpdating = เท็จ
ตั้งค่า Wb = Application.ActiveWorkbook
ActiveSheet.Copy
ตั้งค่า Wb2 = Application.ActiveWorkbook
เลือกกรณี Wb.FileFormat
กรณี xlOpenXMLWorkbook:
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
กรณี xlOpenXMLWorkbookMacroEnabled:
ถ้า Wb2.HasVBProject แล้ว
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
อื่น
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
End If
กรณี Excel8:
xFile = ".xls"
xFormat = Excel8
กรณี xlExcel12:
xFile = ".xlsb"
xFormat = xlExcel12
สิ้นสุดการเลือก
FilePath = Environ$("ชั่วคราว") & "\"
ชื่อไฟล์ = Wb.Name & รูปแบบ (ตอนนี้ "dd-mmm-yy h-mm-ss")
ตั้งค่า OutlookApp = CreateObject ("Outlook.Application")
ตั้งค่า OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & ชื่อไฟล์ & xFile, FileFormat:=xFormat
'xstr = Range("e2") & " ; " & Range("g2")
ด้วย OutlookMail
.แสดง
.To = ช่วง ("e2")
.CC = ช่วง ("g2")
.BCC = ""
.Subject = "อุปกรณ์ Techquidation ที่ยังไม่ได้คืน"
.HTMLBody = "ดูสเปรดชีตที่แนบมาสำหรับรายการที่ยังไม่ได้ส่งคืนในพื้นที่ของคุณ" & " " & .HTMLBody
.Attachments.Add Wb2.FullName
'.ส่ง
จบด้วย
Wb2.ปิด
ฆ่า FilePath & ชื่อไฟล์ & xFile
ตั้งค่า OutlookMail = Nothing
ตั้งค่า OutlookApp = Nothing
Application.ScreenUpdating = จริง
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ดูเหมือนว่าจะเป็น Excel 2016 และ VBA 7.1
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
Oi Cristal, มาโคร minha perde a configuração da assinatura do e-mail, com imagens e formatação original. ตัวแก้ไข Como conigo?

ย่อย Geraremail()

Dim OLapp เป็น Outlook.Application
Dim janela เป็น Outlook.MailItem

ตั้งค่า OLapp = ใหม่ Outlook.Application
ตั้งค่า janela = OLapp.CreateItem(olMailItem)

Arquivo01 = "แผนที่ AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"


กับ janela
ActiveWorkbook บันทึก
.แสดง
.To = Sheets("Base")).Range("A2")).Value
.CC = ชีต("Base")).Range("A5")).Value
.Subject = "Mapa - Acrilo " & รูปแบบ (วันที่ "dd.mm.yy")
assinatura = .ร่างกาย
.Body = "Prezados/as" & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila พิจารณาเป็น vendas previstas ไม่มี S&OP" & Chr(10) & Chr (10) & assinatura
.ไฟล์แนบเพิ่ม Anexo01
จบด้วย

ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คอม a มูดันซา อาไบโซ, คอนเซกี อาจูสตาร์ Porém a letra do corpo da mensagem fica จาก Times New Roman. Gostaria de usar Calibri, como posso alterar o código?

ย่อย Geraremail()

Dim OLapp เป็น Outlook.Application
Dim janela เป็น Outlook.MailItem

ตั้งค่า OLapp = ใหม่ Outlook.Application
ตั้งค่า janela = OLapp.CreateItem(olMailItem)

Arquivo01 = "แผนที่ AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"


กับ janela
ActiveWorkbook บันทึก
.แสดง
.To = Sheets("Base")).Range("A2")).Value
.CC = ชีต("Base")).Range("A5")).Value
.Subject = "Mapa - Acrilo " & รูปแบบ (วันที่ "dd.mm.yy")
assinatura = .ร่างกาย
.HTMLBody = "Prezados/as" & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila พิจารณาเป็น vendas previstas ไม่มี S&OP" & " " & .HTMLBody
.ไฟล์แนบเพิ่ม Anexo01
จบด้วย

ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี มิลล่า
รหัส VBA ต่อไปนี้สามารถช่วยคุณเปลี่ยนแบบอักษรของเนื้อหาอีเมลเป็น Calibri โปรดลองใช้ดู ขอขอบคุณ.
ก่อนรันโค้ด คุณต้องคลิก เครื่องมือ > อ้างอิง ใน Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่างแล้วตรวจสอบ ไลบรารีวัตถุ Microsoft Word ช่องทำเครื่องหมายในไฟล์ ข้อมูลอ้างอิง - VBAProject กล่องโต้ตอบดังภาพหน้าจอที่แสดงด้านล่าง
[img]ฉัน:\工作\周雪明\2022年工作\6月份\文章评论截图\3.png[/img]
Sub Geraremail()
Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem
Dim xDoc As Document 'Click Tools > Reference to enable the Microsoft Word Object Library
On Error Resume Next
Set OLapp = New Outlook.Application
Set janela = OLapp.CreateItem(olMailItem)
Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"
With janela
  ActiveWorkbook.Save
  .Display
  .To = Sheets("Base").Range("A2").Value
  .CC = Sheets("Base").Range("A5").Value
  .Subject = "Mapa - Acrilo " & Format(Date, "dd.mm.yy")
   assinatura = .Body
  .HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & "<br>" & .HTMLBody
  .Attachments.Add Anexo01
End With
Set xDoc = janela.GetInspector.WordEditor
xDoc.Content.Font.Name = "Calibri"
End Sub
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี มิลล่า
รหัส VBA ต่อไปนี้สามารถช่วยคุณเปลี่ยนแบบอักษรของเนื้อหาอีเมลเป็น Calibri โปรดลองใช้ดู ขอขอบคุณ.
ก่อนรันโค้ด คุณต้องคลิก เครื่องมือ > อ้างอิง ใน Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่างแล้วตรวจสอบ ไลบรารีวัตถุ Microsoft Word ช่องทำเครื่องหมายในไฟล์ ข้อมูลอ้างอิง - VBAProject ไดอะล็อกบ็อกซ์ตามไฟล์แนบที่แสดงด้านล่าง
Sub Geraremail()
Dim OLapp As Outlook.Application
Dim janela As Outlook.MailItem
Dim xDoc As Document 'Click Tools > Reference to enable the Microsoft Word Object Library
On Error Resume Next
Set OLapp = New Outlook.Application
Set janela = OLapp.CreateItem(olMailItem)
Arquivo01 = "Mapa AN"
Anexo01 = ThisWorkbook.Path & "\" & Arquivo01 & ".xlsm"
With janela
  ActiveWorkbook.Save
  .Display
  .To = Sheets("Base").Range("A2").Value
  .CC = Sheets("Base").Range("A5").Value
  .Subject = "Mapa - Acrilo " & Format(Date, "dd.mm.yy")
   assinatura = .Body
  .HTMLBody = "Prezados/as," & Chr(10) & Chr(10) & "Segue anexo o mapa de Acrilonitrila considerando as vendas previstas no S&OP." & "<br>" & .HTMLBody
  .Attachments.Add Anexo01
End With
Set xDoc = janela.GetInspector.WordEditor
xDoc.Content.Font.Name = "Calibri"
End Sub
มีความคิดเห็นยังไม่มีการโพสต์ที่นี่
แสดงความคิดเห็นของคุณ
โพสต์ในฐานะแขก
×
ให้คะแนนโพสต์นี้:
0   ตัวอักษร
สถานที่แนะนำ