在为电子邮件VBA检索信息时进行明确的连接

我的macros的目的是检查单个工作表以查找某个范围内的date列表，然后将列出这些date的电子邮件发送到工作表中的电子邮件地址。

我正在处理的当前代码将当前工作表中的date以及前一个工作表中的date连接在一起，而不仅仅是此工作表中的date。 我正在努力使其不发声，试图把“ws”。 每个aCell指令之前，但得到编译错误。 任何build议不胜感激。

Sub Mail_Outlook() Dim ws As Worksheet Dim wsName As Variant Dim OutApp As Object Dim OutMail As Object Dim cell As Range Dim strbody As String Dim string1 As String Dim aCell As Range Dim i As Integer i = 0 For Each wsName In Array("sheet1", "sheet2", "sheet3") Set ws = Worksheets(wsName) 'retrieve all missing dates For Each aCell In ws.Range("Aa1:Aa1000") If aCell.Value <> "" Then i = i + 1 If i <> 1 Then string1 = string1 & ", " & aCell.Value Else string1 = aCell.Value End If End If Next 'send email Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) strbody = "Good day " & ws.Range("E3").Cells & vbNewLine & vbNewLine & _ "" & vbNewLine & vbNewLine & _ "" & vbNewLine & vbNewLine & _ string1 & vbNewLine & vbNewLine & vbNewLine & vbNewLine & _ "(This is an automated message)" & vbNewLine & vbNewLine & _ "Best regards" & vbNewLine & vbNewLine & _ On Error Resume Next With OutMail .To = ws.Range("E5").Text .CC = "" .BCC = "" .Subject = "" .Body = strbody 'You can add a file like this '.Attachments.Add ("C:\test.txt") .Display 'or use .Send End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing Next End Sub 

从OP的评论：

代码不会产生任何错误，但是例如第二封电子邮件包含第一个表单和第二个表单的string，而不仅仅是第二个表单。

Answer 1

在进入循环的第二次迭代之前将string清零。

 For Each wsName In Array("sheet1", "sheet2", "sheet3") Set ws = Worksheets(wsName) string1 = vbNullString 'reset string1 to a zero-length string for each ws 'retrieve all missing dates For Each aCell In ws.Range("Aa1:Aa1000") 'all the rest of the concatenation code next aCell 'all the rest of the email code Next wsName