Question

我一直在研究xlsm工作表，如果它在其他数据文件中找不到匹配项，那么它作为其函数的一部分会在J列中产生“无数据”的结果。

我需要的是让Excel循环通过J列并自动生成电子邮件，如果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:\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看起来很好看，他们指出你需要将wsX变量设置为实际工作表才能设置范围变量rngX。这可能就是你的循环可能无效的原因。很难说，在不知道运行代码时抛出了什么错误。

此外，请确保已启用Outlook的对象库。检查功能区工具＆gt;参考，并确保列出您的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 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

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 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 (i.e. autofiltering)

    OutApp.Quit '<-- quit Outlook
    Set OutApp = Nothing
End Sub

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

3 个答案: