Excel vba email worksheet

[FryGirl]

I have a workbook with a worksheet titled "Strawman - ??????". The question marks could always be something different, but it will always start with "Strawman".

How can I find this sheet an email it through Outlook?

 

[HighAndWilder]

I have a workbook with a worksheet titled "Strawman - ??????". The question marks could always be something different, but it will always start with "Strawman".

How can I find this sheet an email it through Outlook?

Are you saying that you cannot locate the workbook that contains this sheet?

 

[FryGirl]

No. The workbook that I am currently using has a worksheet named "Strawman - ??????". That's the worksheet I would like to e-mail.

I actually meant to say, how can I email this sheet.

 

[HighAndWilder]

No. The workbook that I am currently using has a worksheet named "Strawman - ??????". That's the worksheet I would like to e-mail.

I actually meant to say, how can I email this sheet.

Does this help you? Redirecting

 

[FryGirl]

For a manual process, yes, I know how to do that.

However, I'm distributing this workbook to many individuals, so I was looking for a VBA solution.

 

[HighAndWilder]

For a manual process, yes, I know how to do that.

However, I'm distributing this workbook to many individuals, so I was looking for a VBA solution.

I can't test this at the moment but you could take this for a start.

It was originally cribbed from https://www.mrexcel.com/board/threads/use-vba-to-send-html-email-with-excel-data.1268583/

You will need Outlook set up to your email address.

It uses a list of email address in column A.

HtmlBody text and cell refereces to be changed obviously but there for demonstration.

I would BCC to the recipient and send to yourself.

I will set my Outlook up later.

Public Sub SendEmailFromExcelWithBody()
Dim OutApp As Object, OutMail As Object
Dim ws As Worksheet
Dim i As Long, lRow As Long

On Error GoTo Err_Handler

  Set OutApp = CreateObject("Outlook.Application")
    
  Set ws = ThisWorkbook.Sheets("Sheet1")

  With ws
    
    lRow = .Range("A" & .Rows.Count).End(xlUp).Row

    For i = 1 To lRow
        
      Set OutMail = OutApp.CreateItem(0)
      
      With OutMail
        
        .Importance = 2
        .ReadReceiptRequested = True
        .To = ws.Range("A" & i).Value
        .Cc = ""
        .Bcc = ""
        .Subject = "SSCL Devices with Out-dated Security Patches - " & Cells(i, "E")
        .HtmlBody = "Good Morning/Afternoon," & _
         "Name Assigned to Device: " & ws.Cells(1, 2).Value & _
          "<br><br>" & "Device Name: " & ws.Cells(1, 4).Value & _
          "<br><br>" & "The device above is assigned to you and has been identified as having out of date security patches." & _
          "<br><br>" & "Your device needs to be updated immediately. If you believe this to be incorrect, please contact " & _
          "<br><b>" & "Please reply to this email to confirm: " & _
          "<br><br>" & "Your device name. Please follow the instructions in the document above"
             
        .Attachments.Add ActiveWorkbook.Path & "\ToEmail.xlsx"
               
        .Display
                
      End With
            
    Next i
        
  End With
  
Exit_Handler:

  Set ws = Nothing
  Set OutApp = Nothing
  Set OutMail = Nothing

  Exit Sub

Err_Handler:

  MsgBox "Error Number : " & Err.Number & vbCrLf & "Error Number : " & Err.Description
  
  Resume Exit_Handler
  
End Sub

 

[FryGirl]

Thank you. This got me going.