Gd Morning all,
I am building a VBA spreadsheet and i am stuck on the last few parts and would greatly appreciate any help with the coding.
The last 2 things im stuck with are:
Workbook i have created so far takes a raw data dump, splits it by Name and by region in a separate workbooks. After it selects the people the person is responsible for and takes the unique values and dumps them in Column P, followed by a vlookup on these unique values and dumps the persons email in Q( there can be 1 email, there could be 5 or there could be 20 the number changes per workbook)
1) The first problem i am having is: i want my formula to go through each worksheet and to pick up the emails in Q2:QX and to put them in the email in the TO row as a string, (please note each workbook has various amount of emails). In Q1 i have the Person whos responsible for all the below in Q2:QX therefor i want the Q1 value to go in to the CC
2) The second part which im slightly stick on is getting to send from a different email, i dont want it coming from my mail but froma different email which i do have access.
the code is as followed:
- Sub Email_time()
- Dim Email_Subject, Email_Send_From, Email_Send_To, _
- Email_Cc, Email_Bcc, Email_Body As String
- Dim Mail_Object, Mail_Single As Variant
- Dim sht2 As Worksheet
- Dim lastn As Long
- Dim last As Long
- Dim rng As Range
- Dim sht As Worksheet
- Dim n As Integer
- Dim c As Integer
- Set sht2 = Sheets("Button")
- lastn = sht2.Cells(Rows.Count, "E").End(xlUp).Row
- For c = 2 To lastn
- 'email subject
- Email_Subject = sht2.Range("I2").Value
- Sheets(Range("E" & c).Value).Select
- last = Cells(Rows.Count, "A").End(xlUp).Row
- Set rng = Nothing
- On Error Resume Next
- Set rng = Range("A1:M" & last)
- Email_Body = sht2.Range("I5").Value
- Email_Send_From = "[email protected]"
- ' this is where i am struggling.... i cant think of how to select and make all the emails a string.
- For n = 2 To last
- Email_Send_To = Email_Send_To & ";" & Range("Q" & n).Value
- Next n
- Email_Send_To = "[email protected]"
- Email_Cc = ""
- Email_Bcc = ""
- On Error GoTo debugs
- Set Mail_Object = CreateObject("Outlook.Application")
- Set Mail_Single = Mail_Object.CreateItem(0)
- With Mail_Single
- .Subject = Email_Subject
- .To = Email_Send_To
- .CC = Email_Cc
- .BCC = Email_Bcc
- '.Body = Email_Body
- .HTMLBody = "Hi, " & vbNewLine & vbNewLine & Email_Body & vbNewLine & rangetoHTML(rng)
- End With
- If Err.Description <> "" Then MsgBox Err.Description
- Next c
- MsgBox "Done"
- End Sub
Thank you in advance for your help!