Macro help plz: Need to attach 7 PDF files at a time to Outlook Email

[mazher]

Hi VBA Gurus/ Macro Experts,

Please can someone help me?

I have a list of files exported to pdf format using an Excel macro in the folder

C:\Users\ABC\Desktop\ABC-MAR22-001.pdf
C:\Users\ABC\Desktop\ABC-MAR22-002.pdf
C:\Users\ABC\Desktop\ABC-MAR22-003.pdf
---
---
---
C:\Users\ABC\Desktop\ABC-MAR22-150.pdf


Now I need these files to be attached 7 at a time in Outlook

To email address is same: abc@abc.co.uk

The subject line of the first Emil need to be ABC-MAR22-001 till ABC-MAR22-007

Body as follows

Please find attached the following invoices
ABC-MAR22-001 till ABC-MAR22-007 (7 invoices)


In the last email, i need it like this

Subject ABC-MAR22-148 till ABC-MAR22-150

Body as

Please find attached the following invoices
ABC-MAR22-148 till ABC-MAR22-150 (3 invoices)

Thanks in advance.

Mazi

 

[John_w]

Try this macro. Change the two .Saves to .Send to send the emails.

Public Sub Create_Emails_With_7_PDFs()

    Dim PDFsfolder As String
    Dim file As String, PDFfileName As String
    Dim i As Long, n As Long
    Dim toEmail As String
    Dim emailSubject As String, bodyText As String
    Dim OutApp As Object, OutMail As Object
    
    PDFsfolder = "C:\Users\ABC\Desktop\"
    toEmail = "abc@abc.co.uk"
    
    If Right(PDFsfolder, 1) <> "\" Then PDFsfolder = PDFsfolder & "\"
    
    Set OutApp = CreateObject("Outlook.Application")
    
    i = 0
    n = 0
    
    Do
    
        i = i + 1
        file = Dir(PDFsfolder & "ABC-MAR22-" & Format(i, "000") & ".pdf")
        
        If file <> vbNullString Then
        
            n = n + 1
            PDFfileName = file
            
            If n = 1 Then
                Set OutMail = OutApp.CreateItem(0)
                emailSubject = Left(PDFfileName, InStrRev(PDFfileName, ".") - 1) & " to "
                bodyText = "Please find attached the following invoices:" & vbCrLf & Left(PDFfileName, InStrRev(PDFfileName, ".") - 1) & " to "
            End If
            
            OutMail.Attachments.Add PDFsfolder & PDFfileName
            
            If n = 7 Then
                With OutMail
                    .To = toEmail
                    .Subject = emailSubject & Left(PDFfileName, InStrRev(PDFfileName, ".") - 1)
                    .Body = bodyText & Left(PDFfileName, InStrRev(PDFfileName, ".") - 1) & " (" & n & " invoices)"
                    .Save 'or .Send
                End With
                n = 0
            End If
            
        End If
                    
    Loop Until file = vbNullString
    
    If n > 0 Then
         With OutMail
            .To = toEmail
            .Subject = emailSubject & Left(PDFfileName, InStrRev(PDFfileName, ".") - 1)
            .Body = bodyText & Left(PDFfileName, InStrRev(PDFfileName, ".") - 1) & " (" & n & " invoices)"
            .Save 'or .Send
        End With
    End If
    
    Set OutMail = Nothing

End Sub

 

[mazher]

Extremely thankful @John_w for your reply and time.

I have copied that code in a module when running the macro. nothing happens, no errors, nothing displayed, even nothing in drafts.

 

[John_w]

Does the "C:\Users\ABC\Desktop\" folder exist? Does it contain files matching "ABC-MAR22-nnn.pdf"?

 

[mazher]

Thanks, John for your reply
I have checked and replaced the folder where the PDF files exist.
Here is the path.
C:\Users\Company Name\Desktop\Desktop\

The folder contains the file names like
ABC-MAR22-001.PDF
ABC-MAR22-010.PDF
ABC-MAR22-052.PDF

Still on running the macro nothing happens.

 

[John_w]

Here is the path.
C:\Users\Company Name\Desktop\Desktop\

Is that correct? Desktop\Desktop\ ??

 

[mazher]

I have copied the folder to Drive F on my PC but the same result.
PDFsfolder = "F:\Desktop\"

 

[John_w]

Add this line after the file = Dir line, step through the code with the F8 key and look at the output in the Immediate window.

        Debug.Print PDFsfolder & "ABC-MAR22-" & Format(i, "000") & ".pdf", file

It shows the file being sought and the result.

 

[mazher]

Thanks John again for your reply and time.
On adding that line of code and running the macro using F8, Immediate window it shows the following

F:\Desktop\ABC-MAR22-001.pdf

and when I keep on pressing its shows the same again

I dont have any file named ABC-MAR22-001.pdf

I tried with the following files in the folder

Screenshot

Captured with Lightshot

prnt.sc

 

[mazher]

I figured out the problem, the file names should be in a sequence like

When I changed the file names it worked like a charm

ABC-MAR22-001.pdf
ABC-MAR22-002.pdf
ABC-MAR22-003.pdf
ABC-MAR22-004.pdf
ABC-MAR22-005.pdf
ABC-MAR22-006.pdf
ABC-MAR22-007.pdf
ABC-MAR22-008.pdf
ABC-MAR22-009.pdf
ABC-MAR22-010.pdf
ABC-MAR22-011.pdf
ABC-MAR22-012.pdf
ABC-MAR22-013.pdf
ABC-MAR22-014.pdf
ABC-MAR22-015.pdf
ABC-MAR22-016.pdf

I will extremely thankful if you can incorporate the line of codes so that

1) This account cab be used instead of the default account

Dim OutAccount As Outlook.Account
Set OutAccount = OutApp.Session.Accounts.Item(2)

2) Application.Wait Now + #12:00:10 AM#
to add a delay of 10 seconds before a second email is sent
I do not want to mess up the code and have no idea where to add this line of code to make it working.

Thanks in advance