Email Excel workbook based on email address in a cell.

Wanted to email the active workbook based on the email address highlighted in blue whenever I select the supplier name highlighted in yellow by clicking the green "email supplier" button, is this possible?
C--Users-lfreund-Desktop-C--Users-l.xlsm
LUIS FREUNDAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
on the email address highlighted in blue whenever I select the supplier name highlighted in yellow by clicking the green "email supplier" button
Where exactly i.e. on which sheet? I don't see anything highlighted yellow or a green email supplier button.
0
LUIS FREUNDAuthor Commented:
Hi there....I actually found something that actually works.   But here is where I need some help.  On cell M6 for example is a 4 digit number.  Can the following code be modified at   .Attachments.Add ActiveWorkbook.FullName  to read RFQ & the 4 digit code at M6?  I want the workbook name attachemnt to be the four digit code at M6 with RFQ in front.  If not possible I'll take the 4 digit number.

Sub Email_RFQ()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim sTO As String, sSubj As String

    sTO = [E25]
    sSubj = [M5]

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

    On Error Resume Next
    With OutMail
        .To = sTO
        .CC = ""
        .BCC = ""
        .Subject = sSubj & Range("M6")
        .Body = "Hi Teresa - please update the new On_dock dates from the Main_PN Sheet.  Thank you!" & Range(" N11")
        .Attachments.Add ActiveWorkbook.FullName
        .Display   'or use .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Okay, give this a try....

Sub Email_RFQ()
Dim OutApp As Object
Dim OutMail As Object
Dim sTO As String, sSubj As String
Dim filePath As String

Application.ScreenUpdating = False
Application.DisplayAlerts = False
filePath = ActiveWorkbook.Path & "\RFQ - " & [M6] & ".xlsx"
ActiveWorkbook.Sheets.Copy
ActiveWorkbook.SaveAs filePath, 51
ActiveWorkbook.Close True
sTO = [E25]
sSubj = [M5]

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

On Error Resume Next
With OutMail
    .To = sTO
    .CC = ""
    .BCC = ""
    .Subject = sSubj & Range("M6")
    .Body = "Hi Teresa - please update the new On_dock dates from the Main_PN Sheet.  Thank you!" & Range(" N11")
    .Attachments.Add filePath
    .Display   'or use .Send
End With
If Len(Dir(filePath)) > 0 Then
    SetAttr filePath, vbNormal
    Kill filePath
End If
Kill filePath
On Error GoTo 0

Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

LUIS FREUNDAuthor Commented:
HELL YEAH!!!   Thank you so much!!!!   Perfect!
0
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Luis! Glad it worked as desired.
0
Roy CoxGroup Finance ManagerCommented:
For the best selection of Excel + email examples see Ron de Bruin's page here
1
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.