Bulk emails based on file names by VBA code

[Pey]

Hi everyone,
Under a specific file, for example Q:\Users\XXX\My Documents\File I have 100 excel files with different names.

I want to copy the first sheet of the excel file with a macro and send it to the contacts.
I can write the email adress a certain cell of the file or I can keep them in a list.
How can I copy-paste all the data in the first sheet of each file and paste it into the e-mail and send it immediately? Can you suggest a code for this?

 

[james_martin001]

www.slipstick.com has lots of samples for possible macros with Outlook, in particular.

Not clear to me about your trigger. Ideally automated? Or a manual trigger when files are ready? I prefer a single click on the Quick Access Toolbar for manual trigger.

 

[Logit]

The following code will copy the first sheet of each workbook located in a directory that you specify, and paste that sheet into the master workbook from which
you are working. Once you complete that process, you can then email the master workbook as an attachment or create additional code that will create an
email with the master workbook attached.

Be certain to edit the paths in the code to match the location of files in your computer.

Sub CopyFirstSheetFromWorkbooks()

Dim MyPath As String
Dim FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long
Dim Fnum As Long
Dim mybook As Workbook
Dim basebook As Workbook

    'Fill in the path\folder where the files are
    MyPath = "C:\your_path_here\"
    
    
    'Add a slash at the end if the user forget it
    If Right(MyPath, 1) <> "\" Then
    
        MyPath = MyPath & "\"

    End If


'If there are no Excel files in the folder exit the sub
FilesInPath = Dir(MyPath & "*.xl*")

    If FilesInPath = "" Then
        MsgBox "No files found"
    End If


'Fill the array(myFiles)with the list of Excel files in the folder
Fnum = 0

    Do While FilesInPath <> ""
    
        Fnum = Fnum + 1
        
        ReDim Preserve MyFiles(1 To Fnum)
        
        MyFiles(Fnum) = FilesInPath
        
        FilesInPath = Dir()
    
    Loop


    'Loop through all files in the array(myFiles)
    If Fnum > 0 Then
            
        For Fnum = LBound(MyFiles) To UBound(MyFiles)
            
            Set mybook = Workbooks.Open(MyPath & MyFiles(Fnum))
                mybook.Sheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
            mybook.Close savechanges:=False
        
        Next Fnum
        
        
    End If


End Sub