Hallo,

hier eine Lösung für das Problem:

clsMailData:

Option Explicit

'//Daten
Private strPath As String
Private blnOk As Boolean

Public Property Get Path() As Variant
    Path = strPath
End Property

Public Property Let Path(ByVal vNewValue As Variant)
    strPath = vNewValue
End Property

Public Property Get Task() As Variant
    Task = blnOk
End Property

Public Property Let Task(ByVal vNewValue As Variant)
    blnOk = vNewValue
End Property

modSendMails:

Option Explicit

'//Verweise
'//Microsoft Scripting Runtime
'//Microsoft Outlook xx.x Object Library

'//Konstanten (Einstellungen) -> Bitte anpassen!
Private Const C_DIR As String = "C:\Users\user\Desktop\tmp\Test"
Private Const C_RECIPIENT As String = "someone@somedomain.com"
Private Const C_WORKSHEETNAME As String = "Tabelle1"
Private Const C_VALUE As String = "Aufgabe"
Private Const C_SHOWMAILDIALOG As Boolean = True
Private Const C_SUBJECTTASK As String = "Aufgabe"
Private Const C_SUBJECTNOTASK As String = "Alles OK"

'//Daten
Dim intWkbCount As Integer, intMailCount As Integer

'//Hauptroutine
Public Sub analyseAndSendMails()
    Dim fso As New FileSystemObject
    
    If Not fso.FolderExists(C_DIR) Then
        MsgBox "Angegebenes Verzeichnis existiert nicht.", vbExclamation
        GoTo cleanup
    End If
    
    intWkbCount = 0
    intMailCount = 0
    
    Dim foldDir As Folder, f As File
    Dim colFiles As New Collection
    Dim wkb As Workbook
    Dim rng1 As Range, rng2 As Range
    Dim cData As clsMailData
    
    Set foldDir = fso.GetFolder(C_DIR)
    
    For Each f In foldDir.Files
        If f.Type = "Microsoft Excel-Arbeitsblatt" Then
            intWkbCount = intWkbCount + 1
            
            Set wkb = Application.Workbooks.Open(f.Path, ReadOnly:=True)
            If worksheetExists(wkb, C_WORKSHEETNAME) Then
                With wkb.Worksheets(C_WORKSHEETNAME)
                    Set rng1 = .Range("A1:A10")
                    Set rng2 = .Range("D1:D10")
                End With
                
                Set cData = New clsMailData
                
                With cData
                    .Task = containsValue(Union(rng1, rng2), C_VALUE)
                    .Path = f.Path
                End With
                
                colFiles.Add cData
                
                Set rng1 = Nothing
                Set rng2 = Nothing
            End If
            wkb.Close False
            Set wkb = Nothing
        End If
    Next f
    
    If colFiles.Count = 0 Then
        MsgBox "Der Wert '" & C_VALUE & "' wurde in keiner Arbeitsmappe gefunden.", vbInformation
        GoTo cleanup
    End If
    
    sendMails colFiles
    
    MsgBox "Es wurden " & intWkbCount & " Excel Arbeitsmappen gefunden und analysiert." & vbCrLf & _
        "Des Weiteren wurden " & intMailCount & " Mails erstellt/versendet.", vbInformation
    
cleanup:
    If Err.Number > 0 Then
        MsgBox "Es ist leider ein Fehler aufgetreten." & vbCrLf & _
            "Fehlernummer: " & Err.Number & vbCrLf & _
            "Fehlerbeschreibung: " & Err.Description, vbExclamation
    End If
    
    If Not cData Is Nothing Then Set cData = Nothing
    If Not rng2 Is Nothing Then Set rng2 = Nothing
    If Not rng1 Is Nothing Then Set rng1 = Nothing
    If Not wkb Is Nothing Then Set wkb = Nothing
    If Not colFiles Is Nothing Then Set colFiles = Nothing
    If Not foldDir Is Nothing Then Set foldDir = Nothing
    If Not fso Is Nothing Then Set fso = Nothing
End Sub

Private Function worksheetExists(ByRef wkb As Workbook, ByVal strWksName As String) As Boolean
    Dim wks As Worksheet
    
    On Error Resume Next
    Set wks = wkb.Worksheets(strWksName)
    On Error GoTo 0
    
    worksheetExists = Not CBool(Err.Number)
    Set wks = Nothing
End Function

Private Function containsValue(ByRef rng As Range, ByVal value As String) As Boolean
    Dim c As Range
    
    For Each c In rng.Cells
        If InStr(1, c.value, value) Then
            containsValue = True
            Exit For
        End If
    Next c
End Function

Private Sub sendMails(ByRef colFiles As Collection)
    Dim appOut As Outlook.Application
    Dim outMail As MailItem
    
    On Error Resume Next
    Set appOut = GetObject("Outlook.Application")
    
    If appOut Is Nothing Then
        Set appOut = CreateObject("Outlook.Application")
        
        On Error GoTo 0
        If appOut Is Nothing Then
            Err.Raise 1, "sendMails", "Outlook kann nicht gefunden bzw. geöffnet werden."
        End If
    End If
    On Error GoTo 0
    
    Dim cData As clsMailData
        
    On Error GoTo cleanup
    For Each cData In colFiles
        intMailCount = intMailCount + 1
        Set outMail = appOut.CreateItem(olMailItem)
        
        With outMail
            .Recipients.Add C_RECIPIENT
            If cData.Task Then
                .Subject = C_SUBJECTTASK
            Else
                .Subject = C_SUBJECTNOTASK
            End If
            .Body = cData.Path
            If C_SHOWMAILDIALOG Then
                .Display
            Else
                .Send
            End If
        End With
        
        Set outMail = Nothing
    Next cData
    On Error GoTo 0
    
cleanup:
    If Not cData Is Nothing Then Set cData = Nothing
    If Not outMail Is Nothing Then Set outMail = Nothing
    If Not appOut Is Nothing Then Set appOut = Nothing
End Sub

Bitte die Einstellungen anpassen und anschließend einen Test mit einem Verzeichnis durchführen, in dem 3 Arbeitsmappen liegen.

Eine kurze Rückmeldung wäre nett.

Viele Grüße