Question

在excel中，我有以下代码，它会在K列中为每个包含电子邮件地址的单元格发送电子邮件。

除了表格中的标题不是电子邮件地址之外，这样做会有效，所以它会破坏代码。我试图通过指定＆＃34;如果cell.value = CONTACT METHOD，即标题名称文本，跳过标题，然后转到下一个单元格＆＃34;

但这会导致＆＃34;下一个没有＆＃34;错误。

Sub Mail_small_Text_Outlook()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2013
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Columns("K").Cells.SpecialCells(xlCellTypeConstants)

    If cell.Value Like "*@*" Then
    finaladdress = cell.Value

    Else
    finaladdress = cell.Value & "@email.smsglobal.com"

        Set OutMail = OutApp.CreateItem(0)
        On Error Resume Next
        With OutMail
            .To = finaladdress
            .Subject = "Reminder"
            .Body = "Dear " & Cells(cell.Row, "A").Value _
                  & vbNewLine & vbNewLine & _
                    "Please contact us to discuss bringing " & _
                    "your account up to date"
            'You can add files also like this
            '.Attachments.Add ("C:\test.txt")
            .Display
        End With
        On Error GoTo 0
        Set OutMail = Nothing
    End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

Answer 1

如果您的目标是在循环列 K 中跳过单元格 K1 ，那么：

For Each cell In Columns("K2:K" & Rows.Count).Cells.SpecialCells(xlCellTypeConstants)

Answer 2

您可以将FOR/EACH循环中的代码括在单独的IF语句中，如下所示：

Sub Mail_small_Text_Outlook()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Office 2000-2013
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

On Error GoTo cleanup
For Each cell In Columns("K").Cells.SpecialCells(xlCellTypeConstants)
    If cell.Value = "CONTACT METHOD" Then
        'Do Nothing, or Enter code here
    Else
        If cell.Value Like "*@*" Then
        finaladdress = cell.Value

        Else
        finaladdress = cell.Value & "@email.smsglobal.com"

            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
                .To = finaladdress
                .Subject = "Reminder"
                .Body = "Dear " & Cells(cell.Row, "A").Value _
                      & vbNewLine & vbNewLine & _
                        "Please contact us to discuss bringing " & _
                        "your account up to date"
                'You can add files also like this
                '.Attachments.Add ("C:\test.txt")
                .Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

如何跳过每个循环中的当前单元格

2 个答案: