Kmahraz
Member
Hello I would like to see if i can get some assistance
I send several reports that are stored in a specific location, the reports are sent based on WHOTO list, when i run my code it would look for the path, grab the file that starts with the WHOTO(in Col A), and attach to the email and issue to a pre-defined distribution list.
Is it possible to get an addition to my code to have some kind of a multiple list box, that will let me select just certain WHOTO distributors vs having the reports sent to all the distributors in column A?
I send several reports that are stored in a specific location, the reports are sent based on WHOTO list, when i run my code it would look for the path, grab the file that starts with the WHOTO(in Col A), and attach to the email and issue to a pre-defined distribution list.
Is it possible to get an addition to my code to have some kind of a multiple list box, that will let me select just certain WHOTO distributors vs having the reports sent to all the distributors in column A?
Code:
Sub EmailReport()
Dim OutApp As Object
Dim OutMail As Object
'Use presence of a Path to determine if a mail is sent.
Set Rng = Range(Range("J2"), Range("J" & Rows.Count).End(xlUp))
For Each cell In Rng
Rw = cell.Row
Path = cell.Value
If Path <> "" Then
'Get Date info from Path
Dte = Right(Path, Len(Path) - InStrRev(Path, "\"))
'Get Cost Centre to check for filename (Column A)
FilNmeStr = cell.Offset(0, -9).Value
'Email Address
ToName = cell.Offset(0, -5).Value
'Create Recipient List
For x = 1 To 4
Recp = cell.Offset(0, -x).Value
If Recp <> "" Then
Recp = cell.Offset(0, -x).Value
End If
RecpList = RecpList & ";" & Recp
Next
ccTo = RecpList
'Get Name
FirstNme = cell.Offset(0, -7).Value
Surname = cell.Offset(0, -6).Value
'Loop through files in Path to see if
ClientFile = Dir(Path & "\*.*")
Do While ClientFile <> ""
If InStr(ClientFile, FilNmeStr) > 0 Then
AttachFile = Path & "\" & ClientFile
MailBody = "Dear " & FirstNme & vbNewLine & vbNewLine _
& "Please find attached a copy of your DOP report for " & Dte _
& vbNewLine & vbNewLine _
& "WHOTO: " & cell.Offset(0, -9).Value _
& vbNewLine & _
"Cost centre Description: " & cell.Offset(0, -8).Value _
& vbNewLine & _
"Cost centre Manager: " & FirstNme & " " & Surname _
& vbNewLine & _
"With thanks" & _
Signature
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(o)
With OutMail
.Subject = "Cost Centre Report for - " & Dte
.To = ToName
.cc = ccTo
.Body = MailBody
.Attachments.Add (AttachFile)
.Display
'.Send
End With
Set OutMail = Nothing
Set OutApp = Nothing
RecpList = ""
End If
ClientFile = Dir
Loop
End If
Next
End Sub