Question

我正在使用Ron de Bruin的VBA代码，该代码会将每张工作表的电子邮件地址发送到指定单元格中的地址。这意味着将表单作为附件发送。

我想从多个单元格中获取数据，以便放入电子邮件正文中。

我评论了发送附件的部分，并发送了一封电子邮件，其中包含电子邮件正文中一个单元格的数据。

我无法从多个单元格中获取数据。电子邮件空白。

Sub Mail_Every_Worksheet()
'Working in Excel 2000-2016
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
Dim sh As Worksheet
Dim wb As Workbook
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object

TempFilePath = Environ$("temp") & "\"

If Val(Application.Version) < 12 Then
    'You use Excel 97-2003
    FileExtStr = ".xls": FileFormatNum = -4143
Else
    'You use Excel 2007-2016
    FileExtStr = ".xlsm": FileFormatNum = 52
End If

With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With

Set OutApp = CreateObject("Outlook.Application")

For Each sh In ThisWorkbook.Worksheets
    If sh.Range("B1").Value Like "?*@?*.?*" Then

        sh.Copy
        Set wb = ActiveWorkbook

        TempFileName = "Sheet " & sh.Name & " of " _
                     & ThisWorkbook.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")

        Set OutMail = OutApp.CreateItem(0)

        With wb
            .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

            On Error Resume Next
            With OutMail
                .To = sh.Range("B1").Value
                .CC = ""
                .BCC = ""
                .Subject = "Monthly Shirt Sales"
                Dim cell As Range
                Dim strbody As String
                For Each cell In 
                ThisWorkbook.Sheets("Sheet1").Range("A4:A36")
                strbody = strbody & cell.Value & vbNewLine
                Next
                '.Attachments.Add wb.FullName
                'You can add other files also like this
                '.Attachments.Add ("C:\test.txt")
                .Send   'or use .Display
            End With
            On Error GoTo 0

            .Close savechanges:=False
        End With

        Set OutMail = Nothing

        Kill TempFilePath & TempFileName & FileExtStr

    End If
Next sh

Set OutApp = Nothing

With Application
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub

当我替换

时，它可以从一个单元格发送数据

Dim cell As Range
Dim strbody As String
For Each cell In ThisWorkbook.Sheets("Sheet1").Range("A4:A36")
strbody = strbody & cell.Value & vbNewLine
Next

用这个：

.Body = sh.Range("A4").Value

所以我认为使用它会起作用：

.Body = sh.Range("A4:B36").Value

但它也没有获取数据并发送空白电子邮件。

如何从多个单元格中获取数据？

Answer 1

您需要遍历范围并组合范围中的值，如下例所示;

Dim strbody As String

For Each cell In sh.Range("A1:B2")
    strbody = strbody & cell.Value  & vbNewLine
Next cell

然后在你的outlook中包含strbody with statement

With OutMail
    .To = sh.Range("B1").Value
    .CC = ""
    .BCC = ""
    .Subject = "Monthly Shirt Sales"
    .Body = strbody
    .send   'or use .Display
End With

从多个单元格中获取数据

1 个答案: