Littlemalky
Board Regular
- Joined
- Jan 14, 2011
- Messages
- 223
Hi, I've been using this code in my daily report for ages. All of a sudden, it's no longer generating an email. I feel like there was an Office update or something that could have triggered this? Can anyone determine why this is no longer generating an email? I'm using Office 365.
VBA Code:
Public Sub Mail_Selection_Range_Outlook_Body()
' Working in Office 2000-2010
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String
Dim strbody As String
On Error Resume Next
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
If ActiveWorkbook.Path <> "" Then
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "<font size=""3"" face=""Calibri"">" & _
"Good Morning Team,<br><br><br><br>"
End If
SigString = "C:\Users\" & Environ("username") & _
"\AppData\Roaming\Microsoft\Signatures\Sig.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
With OutMail
.To = "John_Doe@gmail.com"
.CC = ""
.BCC = ""
.Subject = "CCVAS U.S. Daily Sales Report - " & Worksheets("Summary").Range("D4")
.Attachments.Add "\\Blah\Daily Net Sales\" & Format(Date - 3, "yyyy") & "\Q" & DatePart("q", Date - 3) & "\" & _
Format(Date - 3, "MM") & "\CCVAS US Daily Sales Report.xlsb", olByValue, 1
.HTMLBody = strbody & Signature
'& "width='600' height='800'><br>"
'& "width='1200' height='700'><br>
'.HTMLBody = RangetoHTML(rng) & Signature
'.Send
'or use
.Display
End With
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Function GetBoiler(ByVal sFile As String) As String
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.ReadAll
ts.Close
End Function