Create Outlook email with dynamic attachments?

[jmpatrick]

I have an excellent script that came from Ron de Bruin. It creates an Outlook email message, pulls text from a range for the body, and attaches files.

Works great when you need to send the same attachments every time. I need to attach files based on a path created on another sheet.

Here's the email code:

Sub SendPlanRequestEmail()
    
    Dim Ans As VbMsgBoxResult
    Ans = MsgBox("Are you sure you want to Send a Floor Plan Request?", vbYesNo + vbQuestion)
    If Ans = vbNo Then Exit Sub
    
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    Sheets("SendFloorRequest").Visible = True
    Sheets("SendFloorRequest").Select
    'ActiveSheet.Unprotect

    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object

    Set rng = Nothing
    On Error Resume Next
    Set rng = Selection.SpecialCells(xlCellTypeVisible)
    Set rng = Sheets("SendFloorRequest").Range("FloorPlanRequest").SpecialCells(xlCellTypeVisible)
    On Error GoTo 0

    If rng Is Nothing Then
        MsgBox "The selection is not a range or the sheet is protected" & _
               vbNewLine & "please correct and try again.", vbOKOnly
        Exit Sub
    End If

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "jp@testemail.com"
        .CC = Settings.CCEmailReturn.Value
        .BCC = Settings.BCCEmailReturn.Value
        .Subject = "Floor Plan Request"
        .htmlbody = RangetoHTML(rng)
        .Attachments.add ("\\GLC-SERVER\Pulte\AND_Andover_Forest_7220\AND_001\AND_001_plot_plan.pdf")
        .Attachments.add ("\\GLC-SERVER\Pulte\AND_Andover_Forest_7220\AND_001\AND_001_plans.pdf")
        .display
        '.Send
    End With
    On Error GoTo 0
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
   
End Sub

I need to use a path created by formulas on this sheet (named SendFloorRequest). The paths will always be in J1 and J2.

 

[shknbk2]

Try substituting these lines:

        .Attachments.add Sheets("SendFloorRequest").Range("J1").Value
        .Attachments.add Sheets("SendFloorRequest").Range("J2").Value

 

[Domenic]

Try . . .

        .Attachments.Add Worksheets("SendFloorRequest").Range("J1").Value
        .Attachments.Add Worksheets("SendFloorRequest").Range("J2").Value

Hope this helps!

 

[jmpatrick]

Try substituting these lines:

        .Attachments.add Sheets("SendFloorRequest").Range("J1").Value
        .Attachments.add Sheets("SendFloorRequest").Range("J2").Value

Did not work

 

[jmpatrick]

Try . . .

        .Attachments.Add Worksheets("SendFloorRequest").Range("J1").Value
        .Attachments.Add Worksheets("SendFloorRequest").Range("J2").Value

Hope this helps!

Tried this as well. Doesn't work.

 

[shknbk2]

Try this, but before running without debugging, set a breakpoint on the first "filename =" line. Run the code and then step through the code once to see if filename captures what J1 is showing.

        Dim filename as String
        filename = Sheets("SendFloorRequest").Range("J1").Value
        .Attachments.add filename
        filename = Sheets("SendFloorRequest").Range("J2").Value
        .Attachments.add filename

 

[jmpatrick]

OK, this worked!

        .Attachments.Add Worksheets("SendFloorRequest").Range("J1").Value
        .Attachments.Add Worksheets("SendFloorRequest").Range("J2").Value

I had an incorrect path in J1 and J2 so it was not finding the file. When I corrected the formula that creates the path it worked fine.

Thanks for everyone's help

 

[Domenic]

Glad you have sorted it out, cheers!

 

[shknbk2]

Glad it works. If you use my latest "filename" code, you can add additional checking to see if the file exists and add the attachment if it does or provide a warning if it doesn't. Plenty of code for checking whether a filename exists in this forum and on the web.