Hello,
I have been using the below macro which 99% automated except that each day I have to manually input today's date in the subject line. Is there anyway to automate this so that I do not have to do this manually? Thanks!!
My Macro:
Sub Emerging_Mail_Sheet_Outlook_Body()
Sheets("Emerging").Select
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2007
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set rng = Nothing
Set rng = ActiveSheet.UsedRange
'You can also use a sheet name
'Set rng = Sheets("YourSheet").UsedRange
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "Test"
.CC = ""
.BCC = ""
.Subject = "Daily Issues - (Insert Today's Date)
.HTMLBody = RangetoHTML(rng)
.Display 'or use .Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
I have been using the below macro which 99% automated except that each day I have to manually input today's date in the subject line. Is there anyway to automate this so that I do not have to do this manually? Thanks!!
My Macro:
Sub Emerging_Mail_Sheet_Outlook_Body()
Sheets("Emerging").Select
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2007
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set rng = Nothing
Set rng = ActiveSheet.UsedRange
'You can also use a sheet name
'Set rng = Sheets("YourSheet").UsedRange
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "Test"
.CC = ""
.BCC = ""
.Subject = "Daily Issues - (Insert Today's Date)
.HTMLBody = RangetoHTML(rng)
.Display 'or use .Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub