formula to pull data & email to location

Jamesraywebber85

New Member
Joined
Feb 10, 2018
Messages
6
So I have a sheet called "TSA Request" where my employees fill in the data. On the sheet called "employees," I have a list of all of my employees with their emails & the location they are at. When I click on the button called "Manual Move Request, I want it to generate an email to the location using everyone's address at the facility with the subject line of "SSC Manual Move Request:" (with the Customer Number from the sheet). Any help would be greatly appreciated. This is the code that I have for the email but its still a working progress. This is the formula I was using to display a email but its only one from the location.
Code:
=INDEX(Employees!$S$2:$U$994,MATCH($F$16,Employees!$S$2:$S$994,0),3)
This is the VBA to send the email.

Code:
Sub Mail_Sheet_Outlook_Body()'Working in Excel 2000-2016
    Dim rng As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    Dim A As String
    Dim B As String
         
    A = Worksheets("TSA Request").Range("F4:I4").Value
 B = Worksheets("TSA Request").Range("F16:I16").Value
        
        With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With


    Set rng = Nothing
    Set rng = Sheets("TSA Request").Range("A1:K29")


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


    On Error Resume Next
    With OutMail
        .To = B
        .CC = "ssctriage@pods.com"
        .BCC = ""
        .Subject = "SSC Triage Assistance Request: " & A
        .HTMLBody = RangetoHTML(rng)
        .Display   'or use .Display
    End With
    On Error GoTo 0


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


    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub




Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2016
    Dim fso As Object
    Dim ts As Object
    Dim TempFile As String
    Dim TempWB As Workbook


    TempFile = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"


    'Copy the range and create a new workbook to past the data in
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With


    'Publish the sheet to a htm file
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With


    'Read all data from the htm file into RangetoHTML
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.readall
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")


    'Close TempWB
    TempWB.Close SaveChanges:=False


    'Delete the htm file we used in this function
    Kill TempFile


    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

I also have a button thats called "TSA Request", when I press this button it opens lync to a group but it does not copy any info over to it. Is there a VBA code that we can run so when I click on "TSA Request" it would extract & send the data to the recepients in Lync? Here is the hyperlink to send it to the agents.
Code:
[B][URL="im:%3cSip:dlee@pods.com%3e%3cSip:ptoth@pods.com%3e%3cSip:blacert@pods.com%3e%3cSip:tfry@pods.com%3e%3csip:AVelezGarcia@pods.com%3e%3csip:DGermosen@pods.com%3e%3csip:JoGonzalez@pods.com%3e%3csip:mharrison@pods.com%3e"]<sip:< a=""></sip:<>[/URL][EMAIL="test@test.com"]test@test.com[/EMAIL][/B]
 
Last edited by a moderator:

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
I removed IM link from your post as it contained various email addresses, as Spam Bots routinely troll Public User Forums like these looking for email addresses to Spam.
 
Upvote 0

Forum statistics

Threads
1,223,214
Messages
6,170,774
Members
452,353
Latest member
strainu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top