Send E-mail ok but how to log

[v2jtb]

Before I start I have checked out Ron de Bruin's pages and they are fantastic and effectively the macro attached is from his site.

As I am new to Excel programming and use it very little, I struggle with the workings but I am thrilled that I can get this to work.

The Macro sends from a list on the spreadsheet but I would like to log the file being sent in another tab, can this be done?

Sub Send_Files()
'Working in 2000-2010
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim sh As Worksheet
    Dim cell As Range, FileCell As Range, rng As Range

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With

    Set sh = Sheets("E-mailList")

    Set OutApp = CreateObject("Outlook.Application")

    For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConstants)

     
        Set rng = sh.Cells(cell.Row, 1).Range("C1:D1")

        If cell.Value Like "?*@?*.?*" And _
           Application.WorksheetFunction.CountA(rng) > 0 Then
            Set OutMail = OutApp.CreateItem(0)
            
' =======E-Mail body =======================================

       strbody = "<font size=""3"" face=""Calibri"">" & _
                  "Hi" & " " & cell.Offset(0, -1).Value & "," & _
                  "<br><br>As part of XXXXXXXXX compliance procedures we are required to recertify XXXXXXXX that have XXXXXXX to.<br>" & _
                  "I have attached the names of your team and their XXXXXX for each XXXXX (three separate Tabs). You need to confirm if XXXXX is to be XXXXX, XXXXX or XXXX." & _
                  "<br><br>Please note if you state delete then all XXXXX access will be revoked by XXXXXX. Any User access that requires to be amended should be performed by the XXXXXXXXX following the normal BAU process" & " " & "<a href=""http://www.w3schools.com/" & """>(see attached link).</a> <br>" & _
                  "<br><br>Please respond by email, no later than" & "<b> 31st July 2010</B>." & _
                  "<br><br>Failure to respond to this email will result in the mainframe access being removed." & _
                  "<br><br>PS XXXX by XXXXXXX to make amendments as highlighted will result in XXXXXXX revoking access one week after the date above." & _
                  "<br><br>Regards," & _
                  "<br><br>XXXXXXXXXX</font>"

' =======E-Mail body ================================
            
            

            With OutMail
                .to = cell.Value
                .Subject = "Line Manager Report for " & cell.Offset(0, -1).Value
                .HTMLBody = strbody
                .Importance = 2      'High
                
              
                For Each FileCell In rng.SpecialCells(xlCellTypeConstants)
                    If Trim(FileCell) <> "" Then
                        If Dir(FileCell.Value) <> "" Then
                            .Attachments.Add FileCell.Value
                        End If
                    End If
                Next FileCell
                
                .Send  'Or use Display
            End With

            Set OutMail = Nothing
        End If
    Next cell

    Set OutApp = Nothing

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub