Stop macro if column is blank excel vba

2019-08-10 08:21发布

I have made some code but if the range R2:34 is blank, it will still open the template email with no data in him. Please tell me where am I doing the bad connection.

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

1条回答
Lonely孤独者°
2楼-- · 2019-08-10 08:29

Add an IF statement just after setting your range to check if it is all blank cells:

Set emailRng = Worksheets("Sheet1").Range("r2:r34")
If WorksheetFunction.CountBlank(emailRng) = emailRng.Cells.Count Then Exit Sub  'No data
查看更多
登录 后发表回答