VBA Question - Can this be done easily?

[Mich6661]

I need some assistance please all.

I have around 100 excel files that need to be emailed out every 2 days.
I have just lost my admin resource and don't have time to do this manually.

Is there a way, using a defined address book or list of email addresses to create a macro that matches the email address to the file number and will send it automatically?

If not, can anyone recommend an alternative solution? (Pls don't say hire a new admin!!

Many thanks
Mich....

 

[Iceman3395]

Do you send the excel file or a PDF of it?
If excel file is the file protected or not?
Are all files in the same directory?
Are they excel worksheets or workbooks? In other words are all this excel file a separate workbook or a single file with many worksheets?

 

[Iceman3395]

https://www.rondebruin.nl/win/s1/outlook/mail.htm

This link might help as well.

 

[Mich6661]

Do you send the excel file or a PDF of it?
If excel file is the file protected or not?
Are all files in the same directory?
Are they excel worksheets or workbooks? In other words are all this excel file a separate workbook or a single file with many worksheets?

Hi
It will be excel files that are to be sent There will be 1 file per email address group.
The excel files are not protected and are all in the same directory.
There are around 100 individual files

thx
Mich

 

[Eric W]

If you use Outlook, open up a new Excel workbook, and set up Sheet1 like this:

	A	B
Name	File
bob@somewhere.com	C:\MyFiles\Status\File1.xlsx
Jane@somewhere.com	C:\MyFiles\Status\File2.xlsx

<tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]

[TD="align: center"]3[/TD]

[TD="align: center"]4[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

</tbody>

Sheet1​

I suspect you can change the actual email address to a group name, although I haven't tried it.

Then press Alt-F11 to open then VBA editor. From the menu, select Insert > Module. Then paste the following code into the window that opens:

Sub Mail_Workbooks()
Dim OutApp As Object, OutMail As Object, WS As Worksheet, r As Long


    Set OutApp = CreateObject("Outlook.Application")
    
    Set WS = Sheets("Sheet1")
    On Error Resume Next


    For r = 2 To WS.Cells(Rows.Count, "A").End(xlUp).Row
    
        With OutApp.CreateItem(0)
            .To = WS.Cells(r, 1).Value
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = "Hi there"
            .Attachments.Add WS.Cells(r, 2).Value
            .Send
        End With
        DoEvents
    Next r
    
    On Error GoTo 0
    Set OutApp = Nothing
End Sub

Change the parts in red to what you want. Then press Alt-Q to close the editor.

Now just keep Sheet1 updated. The macro will read to the last used row. To run it, press Alt-F8, select Mail_Workbooks and press Run.

 

[Mich6661]

If you use Outlook, open up a new Excel workbook, and set up Sheet1 like this:

	A	B
Name	File
bob@somewhere.com	C:\MyFiles\Status\File1.xlsx
Jane@somewhere.com	C:\MyFiles\Status\File2.xlsx

<tbody>
[TD="align: center"]1[/TD]

[TD="align: center"]2[/TD]

[TD="align: center"]3[/TD]

[TD="align: center"]4[/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]

</tbody>

Sheet1​

I suspect you can change the actual email address to a group name, although I haven't tried it.

Then press Alt-F11 to open then VBA editor. From the menu, select Insert > Module. Then paste the following code into the window that opens:

Sub Mail_Workbooks()
Dim OutApp As Object, OutMail As Object, WS As Worksheet, r As Long


    Set OutApp = CreateObject("Outlook.Application")
    
    Set WS = Sheets("Sheet1")
    On Error Resume Next


    For r = 2 To WS.Cells(Rows.Count, "A").End(xlUp).Row
    
        With OutApp.CreateItem(0)
            .To = WS.Cells(r, 1).Value
            .CC = ""
            .BCC = ""
            .Subject = "This is the Subject line"
            .Body = "Hi there"
            .Attachments.Add WS.Cells(r, 2).Value
            .Send
        End With
        DoEvents
    Next r
    
    On Error GoTo 0
    Set OutApp = Nothing
End Sub

Change the parts in red to what you want. Then press Alt-Q to close the editor.

Now just keep Sheet1 updated. The macro will read to the last used row. To run it, press Alt-F8, select Mail_Workbooks and press Run.

Thanks for this. copied all across and i can get it to send the email but not the attachment.

Regards
Mich

 

[Eric W]

Make sure that the file names are correct. Full path name. Also, the separators should be a backslash, not a pipe character. When you quoted my post, it shows as a pipe, but that could be a result of the forum software. You can try changing

.Send

to

.Display

to see if there's something about that email. Other than those ideas, I'm not sure what to tell you, it works for me.

 

[Mich6661]

Hi Eric

It worked perfectly once i got round the security on our servers.
Thank you so much, it has certainly saved on admin.

Much appreciated

 

[Eric W]

Wonderful! Glad it works for you!