特定のセル値が存在する場合、電子メールを自動的に送信します。本文に隣接値を含める

Question

私はxlsmシート上で作業していました。その機能の一部として、他のデータファイルで一致が見つからない場合、列Jに "No Data"という結果が生成されています。

私が必要とするのは、ExcelがJ列をループして、J = "No Data"の値で、電子メールの本文に列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

少し混乱し、この時点までに持っていたコードがあるが、これはあなたがstarted-取得する必要

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 2

Om3rが持っているどのような、彼らはあなたが必要だと指摘したよさそうです範囲変数rngXを設定する前にwsX変数を実際のシートに設定します。これはあなたのループがうまくいかなかった理由かもしれません。あなたのコードを実行したときにどんなエラーがスローされたのかを知らなくても難しいです。

また、Outlook用のオブジェクトライブラリが有効になっていることを確認してください。リボンの[ツール]> [参照]の下にあるチェックボックスをオンにして、Outlookライブラリがリストされていることを確認します。

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