• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Add an attachment to email [SOLVED]

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
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
 
Hello again,
I was able to figure this out, simple add to my code
Code:
.Attachments.Add ("H:\test\Test1.pdf")
.Attachments.Add ("H:\test\Test2.pdf")
 
Back
Top