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]

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 wrote the macro based on your OP which showed the above sequence, without gaps. I have now modified the macro to look for files matching ABC-MAR22-###.PDF so that gaps in the sequence don't matter.

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.

I have modified the macro as above. It also builds the email subject and body text in a better way, so that these are correct for multiple and single invoices.

The code sets the account for sendng the emails by looking at the account's DisplayName, however you could change it to look for a different property such as UserName or SmtpAddress etc.

Don't forget to change the folder and email address settings near the start of the code, as required.

Option Explicit

#If VBA7 Then
    Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
#Else
    Public Declare Sub Sleep Lib "kernel32" (ByVal milliseconds As Long)
#End If

Public Sub Create_Emails_With_7_PDFs()

    Dim PDFsfolder As String
    Dim file As String, PDFfileName As String
    Dim file1 As String, file2 As String
    Dim n As Long
    Dim toEmail As String
    Dim emailSubject As String, bodyText As String
    Dim sendUsingAccountName As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim OutAccount As Object, SendAccount As Object
    
    Const MAX_ATTACHMENTS_PER_EMAIL = 7
    Const SECONDS_BETWEEN_EMAILS = 10
       
    PDFsfolder = "C:\Users\ABC\Desktop\"
    toEmail = "abc@abc.co.uk"
    sendUsingAccountName = "email@address.co.uk"
    
    If Right(PDFsfolder, 1) <> "\" Then PDFsfolder = PDFsfolder & "\"
    
    Set OutApp = CreateObject("Outlook.Application")
    
    'Find the account for sending the emails
    
    Set SendAccount = Nothing
    For Each OutAccount In OutApp.Session.Accounts
        If OutAccount.DisplayName = sendUsingAccountName Then Set SendAccount = OutAccount
    Next
    
    If SendAccount Is Nothing Then
        MsgBox "Email account '" & sendUsingAccountName & "' not found", vbExclamation
        Exit Sub
    End If
    
    n = 0
    file = Dir(PDFsfolder & "*.pdf")
    
    While file <> vbNullString
        
        If UCase(file) Like "ABC-MAR22-###.PDF" Then
        
            n = n + 1
            PDFfileName = file
            
            If n = 1 Then
                Set OutMail = OutApp.CreateItem(0)
                file1 = Left(PDFfileName, InStrRev(PDFfileName, ".") - 1)
                file2 = ""
            End If
            
            OutMail.Attachments.Add PDFsfolder & PDFfileName
            
            If n = MAX_ATTACHMENTS_PER_EMAIL Then
                file2 = Left(PDFfileName, InStrRev(PDFfileName, ".") - 1)
                emailSubject = file1 & IIf(file2 <> file1, " to " & file2, "")
                bodyText = "Please find attached the following invoice" & IIf(n > 1, "s:", ":") & vbCrLf & file1 & IIf(file2 <> file1, " to " & file2, "") & " (" & n & " invoice" & IIf(n > 1, "s)", ")")
                With OutMail
                    '.SendUsingAccount = SendAccount          'use with early binding of Outlook library
                    Set .SendUsingAccount = SendAccount       'use with late binding of Outlook library
                    .To = toEmail
                    .Subject = emailSubject
                    .Body = bodyText
                    '.Send
                    .Save
                End With
                Sleep SECONDS_BETWEEN_EMAILS * 1000
                n = 0
            End If
            
        End If
                    
        file = Dir
                  
    Wend
    
    If n > 0 Then
        file2 = Left(PDFfileName, InStrRev(PDFfileName, ".") - 1)
        emailSubject = file1 & IIf(file2 <> file1, " to " & file2, "")
        bodyText = "Please find attached the following invoice" & IIf(n > 1, "s:", ":") & vbCrLf & file1 & IIf(file2 <> file1, " to " & file2, "") & " (" & n & " invoice" & IIf(n > 1, "s)", ")")
        With OutMail
            '.SendUsingAccount = SendAccount          'use with early binding
            Set .SendUsingAccount = SendAccount       'use with late binding
            .To = toEmail
            .Subject = emailSubject
            .Body = bodyText
            '.Send
            .Save
        End With
    End If

    MsgBox "Finished"
    
End Sub

 

[mazher]

Extremely thankful to you @John_w for all your time and for helping me out.

You are a legend, hats off to you for writing such an amazing VBA code, it will help me a lot in sending month-end invoices seamlessly, without any trouble.