PDA

View Full Version : [SOLVED] Sending e-mail from Excel with Outlook behaving badly



vanhunk
07-19-2016, 03:57 AM
Sending e-mail from Excel with Outlook behaving differently when running code than when stepping through code:

When stepping through the code I get the intended result (also sometimes happen when running code), but when running the code the message is not displayed properly.

The message (i.e. e-mail body) contains to dates and when the macro functions properly it displays something like:
"Please find attached a report of overdue MOCs for the period 01 January 2006 to 30 June 2016."

When it behaves badly it displays something like:
"Please find attached a report of overdue MOCs for the period 14/9/3/14/85 to ."

How can this be fixed please?

The full code:

Sub eMailReportToManagement()
Dim Source As Range
Dim Dest As Workbook
Dim wb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strbody As String

Dim PeriodStart As String
Dim PeriodEnd As String

Dim ToL As String
Dim CCL As String
Dim BCCL As String

PeriodStart = Format(Range("P5"), "dd mmmm yyyy")
PeriodEnd = Format(Range("O5"), "dd mmmm yyyy")

Set Source = Nothing

On Error Resume Next
Set Source = Worksheets("Report").Range("Print_Area")
On Error GoTo 0

'Source.Select 'For testing purposes only.

If Source Is Nothing Then
MsgBox "Refresh Report and try again.", vbOKOnly
Exit Sub
End If

With Application
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With

'Set wb = ActiveWorkbook
Set wb = ThisWorkbook

Range("RepDateLastSent").Value = Date

'Prepare the distribution lists for the e-mail:
'*********************************************
'Initiate the lists:
ToL = ""
CCL = ""
BCCL = ""

For Each cell In Range("ReportToList")
If ToL = "" Then
If Not cell.Value = "" Then
ToL = cell.Value
End If
Else
If Not cell.Value = "" Then
ToL = ToL & ";" & cell.Value
End If
End If
Next cell

For Each cell In Range("ReportCCList")
If CCL = "" Then
If Not cell.Value = "" Then
CCL = cell.Value
End If
Else
If Not cell.Value = "" Then
CCL = CCL & ";" & cell.Value
End If
End If
Next cell

For Each cell In Range("ReportBCCList")
If BCCL = "" Then
If Not cell.Value = "" Then
BCCL = cell.Value
End If
Else
If Not cell.Value = "" Then
BCCL = BCCL & ";" & cell.Value
End If
End If
Next cell
'*********************************************

'Create new workbook:
Set Dest = Workbooks.Add(xlWBATWorksheet)

'Copy paste source range to new workbook:
'***********************************************
Source.Copy

With Dest.Sheets(1)
.Cells(2, 2).PasteSpecial Paste:=8
.Cells(2, 2).PasteSpecial Paste:=xlPasteValues
.Cells(2, 2).PasteSpecial Paste:=xlPasteFormats
.Cells(2, 2).Select
Application.CutCopyMode = False
End With
'***********************************************

'Name new workbook and temporary storage path:
TempFilePath = Environ$("temp") & "\"
TempFileName = Left(Range("B2"), Len(Range("B2")) - 1)

If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007-2013
FileExtStr = ".xlsx": FileFormatNum = 51
End If

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

strbody = "<font face=Arial>Dear Colleagues,<br><br>" & _
"</b>" & _
"Please find attached a report of overdue MOCs for the period " & PeriodStart & " to " & PeriodEnd & ".<br><br><br><br>" & _
"If you do not want to receive this report, please let me know at your earliest convenience.<br>" & _
"<br><br>Thank you.</font>"

With Dest
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum

On Error Resume Next
With OutMail
.Display
.To = ToL
.CC = CCL
.BCC = BCCL
.Subject = "Overdue MOCs Report"
.HTMLBody = strbody & .HTMLBody
.Attachments.Add Dest.FullName
.Send
End With
On Error GoTo 0

.Close savechanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub

The portion of code that creates message:

strbody = "<font face=Arial>Dear Colleagues,<br><br>" & _
"</b>" & _
"Please find attached a report of overdue MOCs for the period " & PeriodStart & " to " & PeriodEnd & ".<br><br><br><br>" & _
"If you do not want to receive this report, please let me know at your earliest convenience.<br>" & _
"<br><br>Thank you.</font>"

When the code works properly the message looks like the following:



Dear Colleagues,



Please find attached a report of overdue MOCs for the period 01 January 2006 to 30 June 2016.







If you do not want to receive this report, please let me know at your earliest convenience.





Thank you.



“SIGNATURE”
Kind Regards,
vanhunk

snb
07-19-2016, 04:30 AM
Always refer in the code to the sheet (and/or workbook) where the data reside.

e.g.


PeriodStart = Format(thisworkbook.sheets("hunk").Range("P5"), "dd mmmm yyyy")
PeriodEnd = Format(thisworkbook.sheets("hunk").Range("O5"), "dd mmmm yyyy")

vanhunk
07-19-2016, 05:25 AM
Thank you snb, I will try it.

Best Regards,
vanhunk