Tying to automatically email sales reps Excel files with sales history from a folder where each file has the reps' names. Downloaded the code below from John Ross and modified it to fit my needs, but cannot, for the life of me, create an email with the proper reps' addresses. It will create an email for each file in the folder with the proper file attached, but does not attach an address for that sales rep.
Created Stremail with a dlookup and it populates the email address with the same rep name for all, ie the first in the list. Sometimes, it creates multiple emails with the same file until I abort it.
Thought it would be relatively simple but no cigar.
FYI the table for the sales reps emails is :SAname, saemail and matchingname.
Example:
saname saemail matchingname BILL FRENCH bfrench@colemancontainers.com BILL FRENCH.xlsx
Added the matching name to match with the Excel file that is stored in the folder.
Any assistance would be appreciated.
Current Code is:
Private Sub Command45_Click()
Dim Stremail As String
Dim StrFile As String, StrPath As String
'Dim appOutLook As Outlook.Application
'Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
'define where we look for our folder full of pdf files
StrPath = CurrentProject.Path & "\excelfilestorepsforinputdata"
StrFile = Dir(CurrentProject.Path & "\excelfilestorepsforinputdata\*.xlsx")
'loop that directory
Do While Len(StrFile) > 0
'create a new email window
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook 'apply to each new email window
'Stremail = DLookup("[saemail]", "[salesmens emails]", "[matchingname]='" & Dir(CurrentProject.Path & "\excelfilestorepsforinputdata\*.xlsx") & "'")
'.BodyFormat = olFormatRichText
.SentOnBehalfOfName = "user@example.com" 'send as
'.To = Stremail
.Subject = "Sales History for Current Sales Plan"
.HTMLBody = "Please open the attached file to view your data.<br><br>" ' & _
"<h3>Accounts Receivable</h3><b>Billing Department</b><br>Office: 518-555-6393<br>example.com "
.Attachments.Add StrPath + StrFile
.Display
'.Send
.Save 'save as draft
End With
StrFile = Dir
Loop
'message box when the loop finishes
MsgBox "Done!", vbOKOnly
End Sub