Sub SendReportFiles()

    Dim appOutLook As New Outlook.Application
    Dim oMail As Outlook.MailItem
    Dim fsoFile As File, fsoFolder As Folder
    Dim ReportFile, i, nm, km, k
    Dim dict As Scripting.Dictionary
    Dim fso As New FileSystemObject
    Dim Spath, StrFile, sm, sl
    Dim lr As Integer

    Spath = Application.ThisWorkbook.Path & "\"
    Set fsoFolder = fso.GetFolder(Spath)
    
    Set dict = New Scripting.Dictionary
    lr = Sheets("1").Cells(Rows.Count, 1).End(xlUp).Row
    

    For i = 1 To lr
    
        dict.Add Cells(i, 1).Value, 0
        
    Next i
        
    For i = 1 To dict.Count
    Set oMail = appOutLook.CreateItem(olMailItem)

            With oMail
            
                .To = dict.Keys(i)
                .Cc = ""
                .Subject = "mmm" & Format(Now, "dd.mm.yyyy") & ""
                sm = "sss" & Format(Now, "dd.mm.yyyy")
                sl = "Tel.: +" & vbNewLine & _
                "sssssss"
                .Body = sm & vbNewLine & sl
                StrFile = Dir(Spath & "*.docx*")
    
                            .Attachments.Add Spath & StrFile
                            StrFile = Dir
                .Send
                
            Set oMail = Nothing
            End With
            
    Next i

End Sub