Excel VBA脚本通过电子邮件从一个单元发送数据，但不是多个单元
我正在使用Ron de Bruin的VBA脚本，它将每个表单都带有一个电子邮件地址发送到指定单元格中的地址。 这意味着发送表格作为附件，但我只是想发送电子邮件正文中的单元格的数据。 我评论了发送附件的部分，并且能够发送包含电子邮件正文中一个单元格的数据的电子邮件。 但是，当我尝试从多个单元发送数据时，电子邮件到达空白。 我不是一个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 它在我replace时用于在一个单元格中发送数据
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
但它也发送一个空白的电子邮件。
任何人都可以告诉它为什么不会从多个单元格发送数据？
谢谢你的帮助！
您需要遍历范围并合并范围内的值，如下例所示：
Dim strbody As String For Each cell In sh.Range("A1:B2") strbody = strbody & cell.Value & vbNewLine Next cell
然后用声明包含你的outlook的strbody
With OutMail .To = sh.Range("B1").Value .CC = "" .BCC = "" .Subject = "Monthly Shirt Sales" .Body = strbody .send 'or use .Display End With