复制电子邮件HTML正文中的范围

时间:2016-04-14 13:22:06

标签: excel vba excel-vba

我想在电子邮件HTML正文中复制一系列值。

到目前为止,我在另一个趋势中看到了仅在体内复制细胞的方法,并且它有效:

Sub Macro1()
    Dim mainWB As Workbook
    Dim CCID
    Dim SendID
    Dim subject
    Dim body
    Dim otlApp
    Dim OLmail As MailItem

    Set otlApp = CreateObject("Outlook.Application")
    Set OLmail = otlApp.CreateItem(olMailItem)

    Dim oAttach As Outlook.Attachment
    Dim sPath As String

    SendID = NameToRange("Email_To")
    subject = "Email1"

    With OLmail
        .To = SendID
        If CCID <> "" Then
          .cc = CCID
        End If
        .subject = subject
        .Attachments.Add "S:\Documents\Graph1.jpeg", olByValue, 0

        .HTMLBody = .HTMLBody & "<B>Hello,</B><br>" _
        & "<br><B>Introduction</B><br>" & _
                    "<br>" & mainWB.range([101, 42],[102, 50]).Value & _
                    "<br><B>Graph:</B><br>" _
                    & "<img src='Graph1.jpg'" & "width='600' height='300'>" _

        .display
    End With
end sub

1 个答案:

答案 0 :(得分:1)

尝试定义范围,然后像这样循环。

Sub Macro1()

Dim mainWB As Workbook
Dim CCID
Dim SendID
Dim subject
Dim body
Dim otlApp
Dim OLmail As MailItem

'******************************
Dim rng As Range             '*
Dim cell As Range            '*
Dim EMBody As String         '*
'******************************
Set rng = Range("") 'range   '*
For Each cell In rng         '*
EMBody = EMBody & cell.Value '*
EMBody = EMBody & Chr(13)    '*
Next cell                    '*
'******************************

Set otlApp = CreateObject("Outlook.Application")
Set OLmail = otlApp.CreateItem(olMailItem)

Dim oAttach As Outlook.Attachment
Dim sPath As String

SendID = NameToRange("Email_To")
subject = "Email1"

With OLmail
    .To = SendID
    If CCID <> "" Then .CC = CCID
    End If
    .subject = subject
    .Attachments.Add "S:\Documents\Graph1.jpeg", olByValue, 0
    .body = EMBody
    .HTMLBody = "" 'put whatever else you need besides the range values
    .display
End With

End Sub