Question

我的宏的目的是检查单个工作表以查找范围中的日期列表，然后将列出这些日期的电子邮件发送到位于工作表中的电子邮件地址。

我正在使用的当前代码连接当前工作表中的日期以及上一页上的日期，而不仅仅是此工作表上的日期。我努力让它成为一个单一的声音，试着把“ws”。在每个aCell指令之前但是得到编译错误。任何建议都非常感谢。

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的评论：

代码不会产生任何错误，例如第二封电子邮件包含第一张和第二张的字符串，而不仅仅是第二张。

Answer 1

在进入循环的第二次迭代之前将字符串归零。

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

在检索电子邮件VBA

1 个答案: