Insert date in Subject through date picker

[carmine]

Hey all,




I use the below script to send mail from excel sheet and it successful send email & attachments. I wish to have date picker for mail subject which a user can select the date and send the email or an input box.


Thanks in advance.

Sub Send_Files()
 
 
'Working in Excel 2000-2013
 
 
'For Tips see: [URL]http://www.rondebruin.nl/win/winmail/Outlook/tips.htm[/URL]
   Dim OutApp As Outlook.Application
   Dim OutMail As Outlook.MailItem
   Dim sh As Worksheet
   Dim cell As Range
   Dim FileCell As Range
   Dim rng As Range
 
   With Application
       .EnableEvents = False
       .ScreenUpdating = False
   End With
   Set sh = Sheets("send")
   Set OutApp = CreateObject("Outlook.Application")
   For Each cell In sh.Columns("c").Cells.SpecialCells(xlCellTypeFormulas)
   'For Each cell In sh.Columns("c").Cells.SpecialCells(xlCellTypeConstants)
       'Enter the path/file names in the C:Z column in each row
       Set rng = sh.Cells(cell.Row, 1).Range("d1:Z1")
       If cell.Value Like "?*@?*.?*" And _
          Application.WorksheetFunction.CountA(rng) > 0 Then
           Set OutMail = OutApp.CreateItem(olMailItem)
           With OutMail
               .To = cell.Value
               .Subject = "Testfile" [B]'DATE SELECTED BY USER VIA INPUT BOX OR DATE PICKER[/B]
               .Body = "Hi " & cell.Offset(0, -1).Value
               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
               .Display  'Or use Send
           End With
           Set OutMail = Nothing
       End If
   Next cell
   Set OutApp = Nothing
   With Application
       .EnableEvents = True
       .ScreenUpdating = True
   End With
 
 
End Sub