Question

我有一张Excel表和一些宏。当单元格值==到＆＃34;是＆＃34;时，我想自动向某个人发送电子邮件。此外，我只想在今天的日期发送电子邮件。

请看截图：

Private Sub cmdMove_Click()


    'Sub TestFile()
    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("J").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "H").Value) = "Yes" Then

            Set OutMail = OutApp.CreateItem(0)

            On Error Resume Next

            With OutMail
                .To = ThisWorkbook.ActiveSheet("Server").Range("I3").Value

                .Subject = "Reminder"

                .Body = "Dear " & Cells(cell.Row, "Ryan").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")
                .Send  'Or use Display
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
    Next cell

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

End Sub

Answer 1

尝试以下内容。假设日期在A列中并且是实际日期，可以与Date函数返回的内容进行比较。可以对此进行一些整理。

我会注意到@ BruceWayne关于使用Worksheet_Change事件的评论。如果您可以决定哪个（哪些）或哪个列，则确定触发子单元，例如，如果列H的值发生变化，然后测试每个条件并确定是否发送电子邮件，那么您可以通过该事件调用此子目录。

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Column = 8 Then 'e.g. for column H

       TestFile   'name of your sub

    End If

End Sub

注意我改变了你的LCase测试，因为LCase =“是”它永远不会是真的，我使用了键入的函数LCase $。

我已经注释掉了身体的线条：

.Cells(cell.Row, "Ryan").Value

会抛出错误。 “Ryan”部分应该是列参考，例如“A”或1。如果“Ryan”是一个命名范围，那么你可以使用类似的东西：

.Cells(cell.Row, .Range("Ryan").Column)

代码：

Option Explicit

Public Sub TestFile()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim wb As Workbook

    Set wb = ThisWorkbook

    Application.ScreenUpdating = False

    Set OutApp = CreateObject("Outlook.Application")

    On Error GoTo cleanup

    With ActiveSheet

        For Each cell In .Columns("J").Cells.SpecialCells(xlCellTypeConstants)

            If cell.Value Like "?*@?*.?*" And _
               LCase$(.Cells(cell.Row, "H")) = "yes" And .Cells(cell.Row, "A") = Date Then

                Set OutMail = OutApp.CreateItem(0)

                With OutMail

                    .To = wb.Worksheets("Server").Range("I3").Value

                    .Subject = "Reminder"

                  '  .Body = "Dear " & .Cells(cell.Row, "Ryan").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                     'Or use Display
                End With

                Set OutMail = Nothing

            End If
        Next cell

    End With

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

Sheet2代码窗口中的Worksheet_Event代码示例

以及相关的标准模块：

如果单元格的值是＆＃34;是＆＃34;如何通过Excel发送电子邮件

1 个答案: