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

我一直在做一个xlsm表单，作为其函数的一部分，如果在其他数据文件中找不到匹配项，则在J列中产生“无数据”的结果。

我需要的是让Excel循环通过J列，并自动生成一个电子邮件，如果J =“无数据”的值，并在电子邮件的身体，我需要包括在同一行F列的单元格偏移值。

我已经使用了Ron De Bruin代码，并使用来自项目其他地方的类似function的循环代码对其进行了修改。

我不能得到这个function，可以使用一些方向。 这是我到目前为止的代码

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:\Users\Cole\Downloads\Dads Work\XDock\AutoXrpt.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看起来不错，他们指出，您需要将wsXvariables设置为一个实际的表，才能够设置范围variablesrngX。 这可能是为什么你的循环可能没有工作。 如果不知道在运行代码时发生了什么错误，很难说。

此外，一定要启用Outlook的对象库。 请在function区“工具”>“参考”下进行检查，并确保列出了您的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:\Users\Cole\Downloads\Dads Work\XDock\AutoXrpt.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 (ie 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:\Users\0m3r\Desktop\Macro-VBA\0m3r.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