Kmahraz
Member
Hello
Looking for some assistance with the code below, everything work perfectly no issue at all, the code sort the files in a specific folder and attach them to the appropriate emailing list.
What I need is an addition to my code to add two specific files titled " Test1" and "Test2" to each email I am sending.
Regards,
K
Looking for some assistance with the code below, everything work perfectly no issue at all, the code sort the files in a specific folder and attach them to the appropriate emailing list.
What I need is an addition to my code to add two specific files titled " Test1" and "Test2" to each email I am sending.
Regards,
K
Code:
Sub EmailReport2()
Dim OutApp As Object, OutMail As Object, cell As Range
Dim MailBody As String, StrPath As String
'Use presence of a Path to determine if a mail is sent.
Set Rng = Range(Range("I2"), Range("I" & Rows.Count).End(xlUp))
For Each cell In Rng
Path = cell.Value & "\": If Not Path <> "" Then GoTo n
StrPath = cell.Value
'Get Date info from Path
Dte = Right(StrPath, Len(StrPath) - InStrRev(StrPath, "\"))
'Get WHOTO to check for filename (Column A)
FilNmeStr$ = cell.Offset(0, -8).Value: ClientFile$ = Dir(Path & FilNmeStr & "*.*")
If Not Len(ClientFile$) > 0 Then GoTo n
'Email Address
ToName$ = cell.Offset(0, -5).Value
'Create Recipient List
For x = 1 To 4
If cell.Offset(0, -x).Value <> "" Then RecpList = RecpList & ";" & cell.Offset(0, -x).Value
Next
ccTo = Mid(RecpList, 2)
'Get Whoto code
FirstNme$ = cell.Offset(0, -7).Value: Surname$ = cell.Offset(0, -6).Value
MailBody = "Dear " & FirstNme$ & vbNewLine & vbNewLine _
& "Test " & Dte _
& vbNewLine & vbNewLine _
& "WHOTO: " & FilNmeStr$ _
& vbNewLine & _
"Distributor Principal: " & FirstNme & " " & Surname _
& vbNewLine & _
"With thanks" & _
Signature
With CreateObject("Outlook.Application").CreateItem(0)
.Subject = "test "
.To = ToName:
.cc = ccTo:
.bcc = cell.Offset(, 1).Text:
.Body = MailBody
Do While ClientFile <> "": .Attachments.Add (Path & ClientFile): ClientFile = Dir: Loop
.Display
'.Send
End With
RecpList = ""
n: Next
End Sub