Florida1510
New Member
- Joined
- Mar 13, 2020
- Messages
- 35
- Office Version
- 2010
- Platform
- Windows
Folks,
I need some assistance I'm trying to add a second request to my existing macro to either screenshot or copy a range of cells from the ACC Data Input tab - Sheet1 (Range A1:D21). I would like for the range to be placed right under the wording "High Usage SIMs - Average SIM Usage - X.XXMB" which is part of the HTMLBody of this code. For the life of me I can't get it to work. Any help would be truly appreciated.
Sub sendEmail()
' ******************************** Variable Declaration ********************************
' Dim Req_id As Integer, nextReq_id As Integer, x As Integer, y As Integer, rownumber As Integer, _
' colnumber As Integer, finalRow As Integer, finalColumn As Integer, errCounter As Integer
' Dim TestFreq As String, month As String, pvt As PivotTable
Dim RangeToCopy As Range
Dim wsACC As Worksheet, wsContacts As Worksheet
Dim OutApp As Object, OutMail As Object
Dim lRow As Long
Dim PEmailId As String, CompanyName As String, SEmailId As String, CycleClose As String, Now As String
Dim FilesToOpen
' ******************************** Setting variables ********************************
Set wsACC = ThisWorkbook.Sheets("ACC")
Set wsSheet1 = ThisWorkbook.Sheets("ACC Data Input")
Set wsContacts = ThisWorkbook.Sheets("Contacts")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.createitem(0)
' ******************************** processing start ********************************
'Setting width for month column to avoid it being displayed as #### in outlook
CompanyName = wsContacts.Range("A2")
PEmailId = wsContacts.Range("B2")
SEmailId = wsContacts.Range("C2")
CycleClose = wsContacts.Range("D2")
With wsACC
.Activate
lRow = Cells(Rows.Count, 1).End(xlUp).Row
Set RangeToCopy = .Range("A1:L" & lRow + 1)
Columns("A:L").AutoFit
' ********************************** Prepare the email reminder **********************************
Set OutMail = OutApp.createitem(0)
With OutMail
.Display 'or use .Send
.To = PEmailId
.CC = SEmailId
' .BCC = ""
' .attachments.Add
.Subject = CompanyName & " ESS Weekly Update " & Date
.HTMLBody = "<font size=""3""> <p><b>Hello All" & ",<p>" & _
"Below is the ESS Weekly Update for the cycle closing on the " & Now & CycleClose & ". <p>" & _
"Attached is the report for the high data usage devices for the week.<p>" & _
"The table below reflects the current cycle to date usage through " & Date & " and current rate plan allocations.</font>" & RangetoHTML(RangeToCopy) & _
"<p><font color=""grey""><em> * Usage will continue to be monitored through the cycle.</em></font>" & _
"<font size=""3""> <p><b>High Usage SIMs - Average SIM Usage - X.XXMB" & "<p>" & "<font size=""3""> <p><b>Maintenance" & "<p>" & _
"<font size=""3""> <p><b>Billing" & "<p>" & _
"<font size=""3""> <p><b>Items of Note" & "<p>" & _
"<font size=""3""><p> Kindly advise if you have any questions or need further information.</p></font></b>" & OutMail.HTMLBody
End With
End With
ExitHandler:
Application.ScreenUpdating = True
Set OutMail = Nothing
Set OutApp = Nothing
Exit Sub
End Sub
I need some assistance I'm trying to add a second request to my existing macro to either screenshot or copy a range of cells from the ACC Data Input tab - Sheet1 (Range A1:D21). I would like for the range to be placed right under the wording "High Usage SIMs - Average SIM Usage - X.XXMB" which is part of the HTMLBody of this code. For the life of me I can't get it to work. Any help would be truly appreciated.
Sub sendEmail()
' ******************************** Variable Declaration ********************************
' Dim Req_id As Integer, nextReq_id As Integer, x As Integer, y As Integer, rownumber As Integer, _
' colnumber As Integer, finalRow As Integer, finalColumn As Integer, errCounter As Integer
' Dim TestFreq As String, month As String, pvt As PivotTable
Dim RangeToCopy As Range
Dim wsACC As Worksheet, wsContacts As Worksheet
Dim OutApp As Object, OutMail As Object
Dim lRow As Long
Dim PEmailId As String, CompanyName As String, SEmailId As String, CycleClose As String, Now As String
Dim FilesToOpen
' ******************************** Setting variables ********************************
Set wsACC = ThisWorkbook.Sheets("ACC")
Set wsSheet1 = ThisWorkbook.Sheets("ACC Data Input")
Set wsContacts = ThisWorkbook.Sheets("Contacts")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.createitem(0)
' ******************************** processing start ********************************
'Setting width for month column to avoid it being displayed as #### in outlook
CompanyName = wsContacts.Range("A2")
PEmailId = wsContacts.Range("B2")
SEmailId = wsContacts.Range("C2")
CycleClose = wsContacts.Range("D2")
With wsACC
.Activate
lRow = Cells(Rows.Count, 1).End(xlUp).Row
Set RangeToCopy = .Range("A1:L" & lRow + 1)
Columns("A:L").AutoFit
' ********************************** Prepare the email reminder **********************************
Set OutMail = OutApp.createitem(0)
With OutMail
.Display 'or use .Send
.To = PEmailId
.CC = SEmailId
' .BCC = ""
' .attachments.Add
.Subject = CompanyName & " ESS Weekly Update " & Date
.HTMLBody = "<font size=""3""> <p><b>Hello All" & ",<p>" & _
"Below is the ESS Weekly Update for the cycle closing on the " & Now & CycleClose & ". <p>" & _
"Attached is the report for the high data usage devices for the week.<p>" & _
"The table below reflects the current cycle to date usage through " & Date & " and current rate plan allocations.</font>" & RangetoHTML(RangeToCopy) & _
"<p><font color=""grey""><em> * Usage will continue to be monitored through the cycle.</em></font>" & _
"<font size=""3""> <p><b>High Usage SIMs - Average SIM Usage - X.XXMB" & "<p>" & "<font size=""3""> <p><b>Maintenance" & "<p>" & _
"<font size=""3""> <p><b>Billing" & "<p>" & _
"<font size=""3""> <p><b>Items of Note" & "<p>" & _
"<font size=""3""><p> Kindly advise if you have any questions or need further information.</p></font></b>" & OutMail.HTMLBody
End With
End With
ExitHandler:
Application.ScreenUpdating = True
Set OutMail = Nothing
Set OutApp = Nothing
Exit Sub
End Sub