Sending emails with Attachments with VBA

[Whiter]

I have some code which we have been running for two years and needs an overhaul - the code effectively sends out an e mail with a PDF attachment.
I am asking the question early before I sit down and re-code this.

Amendments Needed
The File Location is currently static //cr0-data//xxx/xxx/xxx/xxx/xx - But I need that file location to be dynamic and read from a cell in a spreadsheet (Named Range FilePath or absolute value bg_Variables F5).
Multiple PDF's to One person - at the moment if person x wants 5 things then they are sent 5 PDF's on 5 eMails - could this be coded to drop all those onto one eMail?
Can this be changed to send emails directly not to the drafts folder?

The data is coming from a spreadsheet in excel - this is a daily process so needs to be repeatable and run without interruption etc.

I've made some changes to this code to obscure some things

    ' declare variables
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim RURef As String
    Dim name As String
    Dim pdf As String
    Dim inq As String
    Dim email As String
    Dim subject As String
    Dim sh As Worksheet
    Dim rw As Range
    Dim pdfcheck As Long
    Dim pdfbool As Boolean
    Dim pdftitle As String
    Dim documentName As String
    
    ' create outlook app and account object
    Set xOutApp = CreateObject("Outlook.Application")
    Dim oAccount As Object
    
    pdfbool = False
    
            'itterate through no header rows until we reach an empty row
            Set sh = ThisWorkbook.Sheets("Good")
            For Each rw In sh.Rows
                If sh.Cells(rw.Row, 1).Value <> "Ref" Then
                    If sh.Cells(rw.Row, 1).Value = "" Then
                        Exit For
                    End If
                    
                   'obtain variables from the spreadsheet
                    Ref = sh.Cells(rw.Row, 1).Value
                    name = sh.Cells(rw.Row, 5).Value
                    email = sh.Cells(rw.Row, 6).Value
                    subject = "PDF document" & "_" & sh.Cells(rw.Row, 3) & "_" & RURef
                    inq = sh.Cells(rw.Row, 16).Value
                    title = sh.Cells(rw.Row, 18).Value
                    documentName = sh.Cells(rw.Row, 3).Value
                   
                   
                    ' since vba cant check the validity of a file on a non mapped network drive we use error handling
                    ' to allow for using editable or non editable pdfs. We try editable as a default
                    pdfcheck = 0
                    On Error GoTo pdfhandler: 'go to the pdf handler
                    
                    'construct pdf address
                    pdf = pdftitle
                    pdf = "\\cr2-data1\BDOD_Redesign\RFT_PDF_Requests\RFT Daily Downloads\" & pdf

                    ' create mail item
                    Set xOutMail = xOutApp.CreateItem(0)
                    
                    'constuct the mail item
                    With xOutMail
                        .to = email
                        .CC = ""
                        .BCC = ""
                        .subject = subject
                        .BodyFormat = 2
                        .HTMLBody = GetHTMLBody(name, "document", phone, documentName, inq)
                        '**************************************
                        .SentOnBehalfOfName = "email address"
                        .Attachments.Add pdf
                        '.display
                                   
                        'Put directly into the Drafts folder
                        .Save
                        
                    End With
                End If
nextrw: ' used to skip row if file isnt found
            Next rw
If pdfbool = True Then 'If there were failures let people know otherwise offer to clear the list
    MsgBox "Some Emails stored in Drafts folder. there were some errors please check the email list"
Else
    'If MsgBox("All Emails stored in Drafts folder. Clear the list?", vbYesNo) = vbYes Then Call ClearEmailList(True)
End If
GoTo endsub ' jump over the pdf handler (needed to keep it in the sub)
pdfhandler:
    pdfcheck = pdfcheck + 1 'count the pdf errors for this row
    If pdfcheck > 1 Then ' if there has been more than one failure mark this row and try the next
        'h.Rows(rw.Row).EntireRow.Interior.ColorIndex = 3
        pdfbool = True
        GoTo nextrw
    End If
                    pdf = pdftitle
                    pdf = "file location" & pdf
    Resume ' attempt non editible pdf
endsub:

End Sub

 

[Micron]

Not enough info about your situation to say with any certainty but consider adding pdf string and email values to either a collection, an array or a dictionary object. The latter would not be possible if 2 or more emails need to get the same pdf file. In that case, perhaps a collection that holds each pdf - but you would need an array that gets an additional value (1, then 2, then 3...) for each pdf iteration for one email. That's because you could not get the collection items without knowing the key values, but the keys must be unique. When the last row for an email is processed, you might then retrieve the pdf values by their index values that you get from the array. When you move on to a new email, the array and the collection has to start over.

All that seems kind of complicated to me (I have never done this). The only other thing I can think of is if you have an inner loop in your code that creates a CSV string for a user since your pdf is a string. When there are no more iterations in that loop (because there's no more pdf's for a user) then pass the string to a sub that creates the email and sends it (use .Send and not .Display). That sub could accept all the email parameters - To, CC, Subject and so on. Then the inner loop terminates and passes control to the outer loop and you start over. I presume that you'd have to go through all the rows to look for a particular email value each time, so it would be better if your rows were sorted by email. It should speed things up a bit if you don't have to go through every row each time you reach a new name.

HTH