Results 1 to 3 of 3

Pull multiple emails for location & insert into email

Threaded View

  1. #1
    Forum Contributor
    Join Date
    02-12-2018
    Location
    Clearwater, FL
    MS-Off Ver
    MS 365
    Posts
    214

    Pull multiple emails for location & insert into email

    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.
    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 = "[email protected]"
            .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.
    <sip:< a=""></sip:<>
    Attached Files Attached Files

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Macro to Print all attachments across multiple emails in Outlook folder then delete email
    By Melissa Camp in forum Outlook Programming / VBA / Macros
    Replies: 1
    Last Post: 07-20-2015, 05:45 PM
  2. [SOLVED] RE: VBA to insert new row in same location on multiple sheets?
    By Iomega0318 in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 05-07-2015, 12:19 PM
  3. [SOLVED] Excel Email Functionality - Sending to multiple emails
    By bigmantitus in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 06-18-2013, 11:17 AM
  4. Replies: 2
    Last Post: 05-09-2013, 09:56 PM
  5. How to convert multiple excel files from a given location to PDF and send by email
    By Mdelgado in forum Excel Programming / VBA / Macros
    Replies: 2
    Last Post: 03-25-2013, 05:10 PM
  6. Outlook Macro to Save Emails to Specified Location
    By opattison in forum Outlook Formatting & Functions
    Replies: 1
    Last Post: 11-29-2012, 05:55 AM
  7. Replies: 0
    Last Post: 11-08-2012, 01:07 PM

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1