首页 > 解决方案 > 在 Outlook 中添加范围和文本

问题描述

下面的编码可以很好地发送带有 excel 范围的电子邮件。只想在电子邮件正文顶部的所有“Hello**”(左对齐)。请协助。

Dim OutApp As Object, OutMail As Object
    Dim wdDoc As Object, wdRange As Object
    Dim rng As Range
    Dim i As Long

    Set rng = ThisWorkbook.Sheets("Certificate").Range("A1:O36")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = ""
        .BCC = ""
        .Subject = "Subject"
        .Display


        Set wdDoc = .GetInspector.WordEditor
        Set wdRange = wdDoc.Range(0, 0)

              
        wdRange.InsertAfter vbCrLf & vbCrLf
        
        
        rng.Copy
        
        
        wdRange.Paste


        DoEvents

        Set wdRange = wdDoc.Range(0, wdDoc.Characters.Count)

        'wdRange.ParagraphFormat.Alignment = wdAlignParagraphCenter

        For i = 1 To wdRange.Tables.Count
            wdRange.Tables(i).Rows.Alignment = wdAlignRowCenter
        Next i
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

标签: vbaoutlookms-word

解决方案


请尝试下一个方法:

Sub sendOutlookMail()
    Dim OutApp As Object, OutMail As Object
    Dim wdDoc As Object, wdRange As Object
    Dim rng As Range, i As Long

    Set rng = ThisWorkbook.Sheets("Certificate").Range("A1:O36")
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    With OutMail
        .To = ""
        .BCC = ""
        .subject = "Subject"
        .display

        Set wdDoc = .GetInspector.WordEditor
        With wdDoc
            .Paragraphs(1).Range.InsertAfter ("Hello!" & vbCrLf)
            
            rng.Copy
            .Paragraphs(2).Range.Paste
        End With
    End With
End Sub

推荐阅读