Question

我已经制作了一些代码，但如果范围R2：34为空白，它仍然会打开模板电子邮件中没有数据。请告诉我我在哪里做错连接。

Sub 1()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sTo As String
    Dim spo As String
    Dim emailRng As Range, cl As Range, dtrecuta As Range
    Dim c As Range
For Each cell In Cells.Range("N2:N34")
If LCase(Cells(cell.Row, "N").Value) = "0" Or LCase(Cells(cell.Row, "N").Value) < "480" Then
On Error Resume Next
Cells(cell.Row, "R").Value = Cells(cell.Row, "M").Value
Else
Cells(cell.Row, "R").Value = Null
End If
Next cell
    a = CLng(Date)
    Set emailRng = Worksheets("Sheet1").Range("r2:r34")
    Set dtrecuta = Worksheets("Sheet1").Range("P2")
    For Each cl In emailRng
        sTo = sTo & ";" & cl.Value
    Next
    sTo = Mid(sTo, 2)
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItemFromTemplate("C:\Users\Marius\AppData\Roaming\Microsoft\Templates\statistica.oft")
    On Error Resume Next
    With OutMail
        .To = sTo
        .CC = ""
        .BCC = ""
        .Subject = "TESTARE Statistica pentru data de " & dtrecuta
        strbody = "Buna " & " , " & vbNewLine & vbNewLine & _
                  "Te rog sa trimiti statistica astazi " & a & " pana in ora 10:00, " & _
                  " pentru data de " & dtrecuta & vbNewLine & vbNewLine & "O zi buna." & _
                  " " & vbNewLine & vbNewLine & " Acesta este un mesaj automat nu raspundeti la acest e-mail. "
        .Display
        .Body = strbody & Signature
        .send
    End With
            On Error GoTo cleanup
            Set OutMail = Nothing
cleanup:
    Set OutMail = Nothing
    Set OutApp = Nothing
    Application.ScreenUpdating = True

End Sub

Answer 1

在设置范围后添加一个IF语句，以检查它是否都是空白单元格：

Set emailRng = Worksheets("Sheet1").Range("r2:r34")
If WorksheetFunction.CountBlank(emailRng) = emailRng.Cells.Count Then Exit Sub  'No data

如果列为空，则停止宏excel vba

1 个答案: