VBA to create emails with an attachment based on path (folder)

[Jonnny]

	A	B	C	D	E	F
Row 1	To:	cc	Subject	Body Text	Path of Attachment folder	Attachment name
Row 2	abc@email1.com	abc@email1.com	test email 1	For your information...	C:\Users\ABC\Desktop\SavedFolder\Folder1	12192022Invoice12.pdf

Hi,
I want to display emails with an attachment from a certain folder. It will be used by multiple users so the path is different and the users must enter their path in row 2, column E.
In the folder, there will be multiple documents with all different name. If users enter the file name in row 2, column F, VBA create an email with the attachment.

Below is the code I currently use.

Private Sub CommandButton1_Click()

Dim strbody As String
    Dim xStrFile As String
    Dim xFilePath As String
    Dim xFileDlg As FileDialog
    Dim xFileDlgItem As Variant
    Dim xOutApp As Outlook.Application
    Dim xMailOut As Outlook.MailItem
    Application.ScreenUpdating = False

    Set xOutApp = CreateObject("Outlook.Application")
    Set xMailOut = xOutApp.CreateItem(olMailItem)
    Set xFileDlg = Application.FileDialog(msoFileDialogFilePicker)

 If xFileDlg.Show = -1 Then
        With xMailOut
        .To = ""
        .CC = Rows(2).Columns(4).Value
        .BCC = Rows(2).Columns(3).Value
        .Subject = Rows(2).Columns(5).Value
        .Body = Rows(2).Columns(6).Value
        For Each xFileDlgItem In xFileDlg.SelectedItems
                .Attachments.Add xFileDlgItem
            Next xFileDlgItem
            .Display
    End With
    End If
    Set xMailOut = Nothing
    Set xOutApp = Nothing
    Application.ScreenUpdating = True
End Sub

 

[breynolds0431]

Assuming you have a way to call the code (either in a button or manually running), the below should work for you...

Private Sub CommandButton1_Click()

Dim strbody As String
Dim xStrFile As String
Dim xFilePath As String
Dim xFileDlg As FileDialog
Dim xFileDlgItem As Variant
Dim xOutApp As Outlook.Application
Dim xMailOut As Outlook.MailItem
Application.ScreenUpdating = False

Set xOutApp = CreateObject("Outlook.Application")
Set xMailOut = xOutApp.CreateItem(olMailItem)

'add path and file to variables
Dim aPath As String: aPath = Cells(2, 7).Value & "/"
Dim aFile As String: aFile = Cells(2, 8).Value

With xMailOut
    .To = ""
    .CC = Cells(2, 4).Value
    .BCC = Cells(2, 3).Value
    .Subject = Cells(2, 5).Value
    .Body = Cells(2, 6).Value
    'attaches file using path and file variables
    .attachments.Add aPath & aFile
    .Display
End With
Set xMailOut = Nothing
Set xOutApp = Nothing
Application.ScreenUpdating = True
End Sub

 

[Jonnny]

Thank you so much. It works perfectly.!

Is it also possible to attach multiple attachments?


Below is my current macro.

Private Sub CommandButton1_Click()

Dim strbody As String
Dim xStrFile As String
Dim xFilePath As String
Dim xFileDlg As FileDialog
Dim xFileDlgItem As Variant
Set xOutApp = CreateObject("Outlook.Application")
Set xMailOut = xOutApp.CreateItem(olMailItem)
Application.ScreenUpdating = False


'add path and file to variables
Dim aPath As String: aPath = Cells(2, 6).Value & "/"
Dim aFile As String: aFile = Cells(2, 7).Value

With xMailOut
    .To = Cells(2, 1).Value
    .CC = Cells(2, 2).Value
    .BCC = Cells(2, 3).Value
    .Subject = Cells(2, 4).Value
    .Body = Cells(2, 5).Value
    'attaches file using path and file variables
    .attachments.Add aPath & aFile
    .Display
End With
Set xMailOut = Nothing
Set xOutApp = Nothing
Application.ScreenUpdating = True
End Sub

 

[breynolds0431]

It's possible to loop through the specified folder and attach multiple files from it. Would you want all files in the folder attached to the email? Or are there specific ones?

 

[Jonnny]

I would like to attach multiple selected files from the specified folder.
E.g) I have several check boxes and only checked files to be attached from the specified folder. Would it be possible?
Thank you so much in advance your advice.

 

[breynolds0431]

Will there be a set number of checkboxes for each row? Or will all rows use the same checkbox collection?

If you can provide a visual of how it will look, that would be helpful.

 

[Jonnny]

I would like to have multiple attachments in the email when it is selected.
e.g) Row 6, 7 boxes are checked, then the attachment for Row6 and Row7 needs to be attached in the email.
I can do it for one single attachment but struggling to for multiple attachments..
It doesn't have to be with checkboxes, if there are other ways to select.

 

[breynolds0431]

You could set up checkboxes, sure. Not sure if that would be efficient as I'm not sure how much your data would change. The other thing you could do would be just to include a "Attach?" column with "YES" or "NO" values. You could also set up all the form checkboxes you need and set the cell link to the adjacent cell under the "Attach?" column, where the values would be "TRUE" or "FALSE".

The below is how you'd loop through the Attach? column and skip or add the needed attachment.

NOTE: in your screenshots, I didn't see where the To, CC, or BCC values went and I'm not sure how you'd list those in the new format you have.

Private Sub CommandButton1_Click()

Dim xOutApp As Object: Set xOutApp = CreateObject("Outlook.Application")
Dim xMailOut As Object: Set xMailOut = xOutApp.CreateItem(olMailItem)

'set range for loop to look through - column F is the Attach? column
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1")
Dim rng As Range: Set rng = ws.Range("F5:F" & ws.Cells(ws.Rows.Count, 6).End(xlUp).Row)
Dim c As Range

Application.ScreenUpdating = False

'add path and file to variables
Dim aPath As String: aPath = ws.Cells(3, 3).Value & "\"

With xMailOut
    .To = ""
    .CC = ""
    .BCC = ""
    .Subject = ws.Cells(1, 3).Value
    .Body = ws.Cells(2, 3).Value
    'loops through responses in column F to determine if corresponding attachment should be added
    For Each c In rng.Cells
        If ws.Cells(c.Row, 6).Value = "YES" Then 'or use "TRUE" if using form checkbox
            .attachments.Add aPath & ws.Cells(c.Row, 5).Value & ".pdf"
        End If
    Next c
    .Display
End With

Set xMailOut = Nothing
Set xOutApp = Nothing

Application.ScreenUpdating = True

End Sub

 

[breynolds0431]

I meant to share this image with you yesterday, which gives you a visual on column F and the "Attach?" column.

 

[Jonnny]

Thanks a lot.! It works perfectly.
Do you know if it is possible to have excel table in body?
e.g) B4:E8 table in the screenshot to be in the mail body. I am not sure if this even works with VBA.