在檢索電子郵件信息VBA時做出明確的連接

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