如果存在特定的单元格值，则自动发送电子邮件;在主体中包含相邻的值

Question

我一直在研究一个xlsm表，作为其功能的一部分，如果它在其他数据文件中找不到匹配，则在J列中产生"No Data"的结果。

我需要的是通过列J有Excel循环，并自动生成电子邮件，如果J中的值="无数据"，在电子邮件的正文中，我需要包括来自同一行的F列的单元格偏移值。

我使用了Ron De Bruin代码，并使用项目中其他地方类似函数的循环代码对其进行了修改。

我不能让这个功能，可以使用一些指导。这是到这里为止的代码

Private Sub EmailIC()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'This macro adapted from: http://www.rondebruin.nl/win/s1/outlook/bmail4.htm
    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim wbXLoc As String, wbX As Workbook, wsX As Worksheet, wsXName As String
    Dim Xlr As Long
    Dim rngX As Range, cel As Range, order As Range
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)
    wbXLoc = "C:UsersColeDownloadsDads WorkXDockAutoXrpt.xlsm" 
    wsXName = "AutoX"
    Set wsX = wbX.Sheets(wsXName)
    'Loop through Column J to determine if = "No Data"
    With wbX
         Xlr = .Sheets("AutoX").Cells(Rows.Count, 1).End(xlUp).Row
         Set rngX = wbX.Sheets("AutoX").Range("J2:J" & Xlr)
    End With
 'do the loop and find
    For Each cel In rngX
        If cel.Value = "No Data" Then
            On Error Resume Next
               With OutMail
                   .to = "robe******@msn.com"
                   .CC = ""
                   .BCC = ""
                   .Subject = "Need Pick Face please!"
                   .Body = rngX.cel.Offset(0, -4).Value
                   .Send
               End With
            On Error GoTo 0
         Set OutMail = Nothing
         Set OutApp = Nothing
       End If
    Next cel
End Sub

Answer 1

Om3r的内容看起来不错，但他们指出，在能够设置范围变量rngX之前，您需要将wsX变量设置为实际的工作表。这可能就是为什么你的循环可能不起作用。在不知道运行代码时抛出了什么错误的情况下很难说。

另外，请确保启用了Outlook的对象库。检查功能区下的工具>参考，并确保你的Outlook库被列出。

Answer 2

你可能想试试这个(注释)代码:

Option Explicit
Private Sub EmailIC()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'This macro adapted from: http://www.rondebruin.nl/win/s1/outlook/bmail4.htm
    Dim OutApp As Outlook.Application
    Dim wbXLoc As String, wsXName As String
    Dim cel As Range, order As Range
    Set OutApp = CreateObject("Outlook.Application")
    wbXLoc = "C:UsersColeDownloadsDads WorkXDockAutoXrpt.xlsm"
    wsXName = "AutoX"
    With Workbooks.Open(wbXLoc).Worksheets(wsXName) '<-- open 'wbXLoc' workbook and reference its 'wsXName' worksheet
        With .Range("J1", .Cells(.Rows.Count, "J").End(xlUp)) '<--| reference its column "J" cells from row 1 down to its last non empty cell
            .AutoFilter field:=1, Criteria1:="No Data" '<--| filter referenced cells with "No Data" criteria
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any cell ha been filtered othre than the header (in row 1)
                For Each cel In .Resize(.Rows.Count - 1).Offset(1).SpecialCells(XlCellType.xlCellTypeVisible) '<-- loop through filtered cells (skippin header in row 1)
                    With OutApp.CreateItem(olMailItem) '<-- cerate and reference a new mail item
                        .to = "robe******@msn.com"
                        .CC = ""
                        .BCC = ""
                        .Subject = "Need Pick Face please!"
                        .Body = cel.Offset(0, -4).Value
                        .Send
                    End With
                Next cel
            End If
        End With
    End With
    ActiveWorkbook.Close False '<--| close opened workbook discarding changes (i.e. autofiltering)
    OutApp.Quit '<-- quit Outlook
    Set OutApp = Nothing
End Sub

Answer 3

对你在做什么有点困惑，但这应该让你开始-

Option Explicit
Private Sub EmailIC()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'This macro adapted from: http://www.rondebruin.nl/win/s1/outlook/bmail4.htm
    Dim OutApp As Object ' Outlook.Application
    Dim OutMail As Outlook.MailItem
'    Dim wbXLoc As String
'    Dim wbX As Workbook
    Dim wsX As Worksheet
'    Dim wsXName As String
'    Dim Xlr As Long
    Dim rngX As Range
    Dim cel As Range
'    Dim order As Range
    Set OutApp = CreateObject("Outlook.Application")
'    wbXLoc = "C:Usersm3rDesktopMacro-VBAm3r.xlsm"
'    wsXName = "Sheet2"

    Set wsX = ThisWorkbook.Worksheets("AutoX")
'    wsXName = "AutoX"
'    Set wsX = wbX.Sheets(wsXName)
    'Loop through Column J to determine if = "No Data"
'    With wbX
'         Xlr = .Sheets("AutoX").Cells(Rows.Count, 1).End(xlUp).Row
'         Set rngX = wbX.Sheets("AutoX").Range("J2:J" & Xlr)
'    End With
    Set rngX = wsX.Range("J2", Range("J65536").End(xlUp))
    'do the loop and find
    For Each cel In rngX
        If cel.Value = "No Data" Then
        Set OutMail = OutApp.CreateItem(olMailItem)
            Debug.Print cel.Value
            Debug.Print cel.Offset(0, -4).Value
'            On Error Resume Next
               With OutMail
                   .To = "robe******@msn.com"
                   .CC = ""
                   .BCC = ""
                   .Subject = "Need Pick Face please!"
                   .Body = cel.Offset(0, -4).Value
                   .Display
               End With
            On Error GoTo 0
       End If
    Next cel
    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub