MailEnvelope with multiple attachments from filepicker dialog

[szita2000]

Hi Guys.

I managed to slim down our shift changeover document by changing from Outlook mailing, to MailEnvelope.
The process is O.K. I had to do this as multiple of our guys had issue starting up outlook. (Corporate runs addons that are heavy)
Now I am stuck on how to allow them to add possible multiple attachments.
(These attachments are usually pictures)

My plan is to add a checkbox on the sheet they fill in, and if the checkbox ticked they can add attachments with the msoFileDialogFilePicker.
I can just about figure out the code for a single attachment, but I don't know how to allow my users to select multiple attachments.

The code below is from Ron de Bruin

I can invoke the system filedialog if a checkbox is checked on Sheet1.
I can allow for multiple selections, but I have no idea how to put them in an array that can be picked up by the
mailenvelope.attachments collection.

Sub Send_Range_Or_Whole_Worksheet_with_MailEnvelope()
'Working in Excel 2002-2016
    Dim AWorksheet As Worksheet
    Dim Sendrng As Range
    Dim rng As Range


    On Error GoTo StopMacro


    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With


    'Fill in the Worksheet/range you want to mail
    'Note: if you use one cell it will send the whole worksheet
    Set Sendrng = Worksheets("Muszak").Range("A1:E25")


    'Remember the activesheet
    Set AWorksheet = ActiveSheet


    With Sendrng


        ' Select the worksheet with the range you want to send
        .Parent.Select


        'Remember the ActiveCell on that worksheet
        Set rng = ActiveCell


        'Select the range you want to mail
        .Select


        ' Create the mail and send it
        ActiveWorkbook.EnvelopeVisible = True
        With .Parent.MailEnvelope


            ' Set the optional introduction field thats adds
            ' some header text to the email body.
'            .Introduction = "This is test mail 2."


            With .Item
                .To = "random@email.address"
                .CC = ""
                .BCC = ""
                .Subject = "Shift Changeover " & Sheet1.Range("D2").Value & " - " & Sheet1.Range("D3").Value
                .Send
            End With


        End With


        'select the original ActiveCell
        rng.Select
    End With


    'Activate the sheet that was active before you run the macro
    AWorksheet.Select


StopMacro:
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    ActiveWorkbook.EnvelopeVisible = False


End Sub

Thanks

Thomas

 

[daverunt]

Hi,

I have some code which takes the ApplicationFileDialogpicker and puts the files into an array, allowing you to extract the array detail for the attachments later.
I tried nesting the 2 With blocks but could not. Maybe someone else can simplify this.

I hope you can extract what you need from it.

Sub Test_Mail()

Dim myArray As String

ActiveWorkbook.EnvelopeVisible = True

   With Application.FileDialog(msoFileDialogFilePicker)
            .AllowMultiSelect = True
            If .Show <> 0 Then
            
                
               ReDim arrFiles(1 To .SelectedItems.Count)
               For idx = 1 To .SelectedItems.Count
               arrFiles(idx) = .SelectedItems(idx)
               Next
               
                     
            End If
           
            End With

  With ActiveSheet.MailEnvelope
 .Item.To = "fred@yahoo.com"

 .Item.Subject = "Subject text"
             
              
            For i = 1 To UBound(arrFiles)
                    .Item.Attachments.Add (arrFiles(i))
             Next i
     

 
 .Item.Send
 End With
            

End Sub

 

[daverunt]

Dim myArray As String - junk

 

[szita2000]

Hi daverunt.
Thanks very much!

I was thinking the same, I just couldn't figure out the syntax to pick up an array from the filepicker.

I will cobble it together and test it, to see if a mini loop inside the with.

I hope that if I loop the .attachments.add it will add all of them


Thanks again.

 

[szita2000]

Hey guys!

It is working!

Thanks for the help.

 

[daverunt]