Script to email specific workbooks to corresponding email addresses

[Bungu]

Hi all,

I have multiple workbooks that are created weekly which needs to be sent out to the corresponding parties. This is very time consuming and sometimes workbooks are missed in the process. There are about 100 workbooks. The workbook contains the name of the supplier and then a date is attached to it. So, the date changes weekly for the name of the workbook. The corresponding party then, fills out the workbook based on the instructions provided. I have a separate workbook with all the email addresses for the suppliers.

I want to automate emailing these workbooks with the generic instructions, to the corresponding parties using Outlook. I am fairly new to VBA and am learning it on my own. Let me know if you need additional details.

 

[Logit]

.
This resource is the "bible" on emailing via VBA & Outlook :

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

 

[Bungu]

Hi Logit-i am using the same script but having trouble matching the workbooks to the emails. Is there a way to identify the workbook by its supplier name, match the master file with all the emails and send based on supplier name?

 

[Logit]

.
When the new workbooks are created, I would save them all in the same folder. Name each workbook beginning with the supplier name and then the date.
Have the supplier email address (before the @ symbol) the same as the workbook name.

For example: JohnQPublic@yahoo.com Workbook name : JohnQPublic 11/5/2018

Then you can use the LEFT function to match the workbook with the supplier's email address.

 

[Bungu]

Hi Logit- still lost on this one. All the supplier workbooks are stored in one folder. If the workbook was ABCDEFG 110518 and the supplier email is johndoe@abcdefg.com, how do i tie it off to be able to send the email?
How do i get the function to go through each workbook and choose the correct email and send the email?

I thought of trying the vlookup up but ran into the same issue of how to get the script to run through all workbooks and send. Maybe my logic is off on this and maybe i should tie the email to the workbook instead.

 

[Logit]

.
"Name each workbook beginning with the supplier name ..."

 

[Bungu]

Hi Logit-Sorry for the delay in getting back to you.
All the workbooks have been named with the supplier name in the front of it. The supplier email address are in a different workbook. I am not following your comment on "Have the supplier email address (before the @ symbol) the same as the workbook name."

I have pasted the script that I am working with. Please let me know if you see any gaps. I have been watching videos and adding some of this stuff.

This is one of the suppliers and email address from the supplier list work book:
[TABLE="width: 1247"]
<colgroup><col><col><col><col><col><col></colgroup><tbody>[TR]
[TD]VNAME[/TD]
[TD]VNDNO[/TD]
[TD]BUYER CODE[/TD]
[TD]BUYER NAME[/TD]
[TD]SUPPLIER CONTACT NAME[/TD]
[TD]SUPPLIER CONTACT E-MAIL[/TD]
[/TR]
[TR]
[TD]ULINE INC[/TD]
[TD]880800[/TD]
[TD]JM[/TD]
[TD]John Miller[/TD]
[TD]N/A[/TD]
[TD]customer.service@uline.com [/TD]
[/TR]
</tbody>[/TABLE]


The weekly workbook that I am trying to send out will be saved as ULINE INC 110518 for this week. The date will change weekly.


Script:


Sub Script_for_sending_emails()
Dim wb1 As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String





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


Set wb1 = ActiveWorkbook


'Make a copy of the file/Open it/Mail it/Delete it
'If you want to change the file name then change only TempFileName
TempFilePath = Environ$("temp") & ""
TempFileName = "Copy of " & wb1.Name & " " & Format(Now, "dd-mmm-yy h-mm-ss")
FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))


wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr




Dim OutApp As Object
Dim OutMail As Object


'To run in a loop until the end of the email sheet
Dim i As Long
For i = 2 To Sheet1.Cells(Rows.Count, 1).End(xlUp).Row




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


On Error Resume Next
With OutMail
'.To = ""
'---------------------------------------------------
.To = ActiveWorkbook.Sheets("Sheet1").Range("C1").Value
'-----------------
'.To = "GroupName"
'-----------------


.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
'.Attachments.Add TempFilePath & TempFileName & FileExtStr
.Attachments.Add "C:\Users\BJoseph\Desktop\Mail Merge testing\Exception report verbiage.docx"
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display
.Send 'or use .Display
End With
On Error GoTo 0
'------------------------------------------------------------------------------
' The receiver can see the original mail address in the properties.
'.SentOnBehalfOfName = """John DOe"" <JohnDoe@yahoo.com>"
'-------------------------------------------------------------------------------




'Delete the file
Kill TempFilePath & TempFileName & FileExtStr


Set OutMail = Nothing
Set OutApp = Nothing


With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub



I do not know how to put the LEFT function in this mix and then do the loop to send the email. Let me know if you need more details. I feel as though I am doing a poor job explaining this.

 

[Norie]

How are the workbooks to be emailed created each week?

 

[Bungu]

Hi Norie- they will be emailed via outlook

 

[Norie]

Yes, but how are the workbooks being created?