Macro to highlight File Name

[howard]

I have file names in Col A on sheet1 , email addresses in Col b next to the file name and a macro which enables the user to select a file and to attach to outlook and then email the file


I would like the code amended so that when the file is selected and attached the following is done


1) The file name in Col A is highlighted in Yellow once it is attached
2) If the same file is selected again , then I message will up "File already selected-do you want to attach again ?"



your assistance is most appreciated

Dim wn$
Sub SendFiles()
Dim lCount As Long, sht As Worksheet, vFilenames, sPath$, lFilecount As Long, sFullName$
 sPath = "C:\Sales Reports\"     ' your path here

ChDrive sPath
ChDir sPath
wn = ThisWorkbook.Name
vFilenames = Application.GetOpenFilename("Microsoft Excel files (*.xls),*.xlsx", , "Select the file(s) to open", , True)
If TypeName(vFilenames) = "Boolean" Then Exit Sub
For lCount = LBound(vFilenames) To UBound(vFilenames)
    Workbooks.Open vFilenames(lCount), UpdateLinks:=False
    Application.CutCopyMode = False
    Sheets(Array("summary")).Copy
    ActiveWorkbook.SaveAs Replace(vFilenames(lCount), ".xlsx", "") & "_summary.xls", FileFormat:=xlNormal
    vFilenames(lCount) = ActiveWorkbook.FullName
    For Each sht In Sheets(Array("summary"))
        Sheets(sht.Name).UsedRange.Copy
        Sheets(sht.Name).[a1].PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Next
    ActiveWorkbook.Close True
    Application.DisplayAlerts = True
    Application.CutCopyMode = True
Next
 Mailfiles "markus.fredereick@solms.com, vFilenames
 ActiveWorkbook.Close True
 'Kill vFilenames(lCount)
End Sub


Sub Mailfiles(mail_ad$, vFiles)
Dim oMailItem As Object, oOLapp As Object, lCt&, r As Range, sh As Worksheet
'Set oOLapp = CreateObject("Outlook.application")
Set oOLapp = GetObject(, "Outlook.application")            
Set oMailItem = oOLapp.CreateItem(0)
With oMailItem
    .To = mail_ad
      .Subject = Application.ActiveWorkbook.Name & "  -Sales report"
         
    .Display
    Set sh = Workbooks(wn).Sheets("sheet1")                 
'    MsgBox "This workbook: " & wn & vbLf & "Active: " & ActiveWorkbook.FullName
    Set r = sh.[a:a].Find(ActiveWorkbook.Name, sh.[a1], xlValues, xlPart)
    If Not r Is Nothing Then .cc = CStr(r.Offset(, 1).Value)
  
    
    .body = "Attached please sales Report as at  " & Format(Application.EoMonth(Date, -1), _
    "mmm yyyy") & " vs the Prior Year sales" & vbNewLine & vbNewLine
      
    
    
    .body = .body & "Regards" & vbNewLine & vbNewLine & "Dave"
    For lCt = LBound(vFiles) To UBound(vFiles)
        .Attachments.Add CStr(vFiles(lCt))
    Next
    Set oOLapp = Nothing
    Set oMailItem = Nothing
End With
End Sub

 

[howard]

I have also posted on link below

https://www.excelforum.com/excel-pr...age-box-and-highlight-file-name-in-col-a.html