Hi All
I hope that somebody can help me if this is possible. I am new at this so please bear with me. I am sending emails with the code below and it works fine. What I would like to do is save those emails to my drive for record purposes. Is this possible
Thanks
Preston
Dim OutApp As Object
Dim OutMail As Object
Dim Dest As Variant
Dim SDest As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' email address in worksheet
Dest = cell.Offset(0, 1).Value
With OutMail
.To = Dest
.CC = ""
.BCC = ""
.Subject = Filename
.Body = "Good Day" & vbNewLine & vbNewLine & "Please find attached your monthly shedules."
.Attachments.Add ActiveWorkbook.FullName
'.Attachments.Add (Path & sfile)
.Send 'or use
'.Display
.OriginatorDeliveryReportRequested = True
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
[TABLE="width: 827"]
<colgroup><col width="78" style="width: 59pt; mso-width-source: userset; mso-width-alt: 2852;"><colgroup><col width="102" style="width: 77pt; mso-width-source: userset; mso-width-alt: 3730;"><colgroup><col width="102" style="width: 77pt; mso-width-source: userset; mso-width-alt: 3730;"><colgroup><col width="819" style="width: 614pt; mso-width-source: userset; mso-width-alt: 29952;"><tbody>[TR]
[TD="width: 78, bgcolor: #0070C0"]INST
[/TD]
[TD="width: 102, bgcolor: #0070C0"]DED TYPE[/TD]
[TD="width: 102, bgcolor: #0070C0"]COUNT[/TD]
[TD="width: 819, bgcolor: transparent, align: left"]
<tbody>
[TD="width: 819, bgcolor: #0070C0"] CONTACTS [/TD]
</tbody> [/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]ABH[/TD]
[TD="bgcolor: transparent"] [/TD]
[TD="bgcolor: transparent"]7[/TD]
[TD="bgcolor: transparent"]Ebfundservices@metropolitan.co.za [/TD]
[/TR]
[TR]
[TD="width: 78, bgcolor: transparent"]ADD[/TD]
[TD="width: 102, bgcolor: transparent"] [/TD]
[TD="width: 102, bgcolor: transparent"]1[/TD]
[TD="width: 819, bgcolor: transparent"]AFRFContributions@aforbes.co.za;KgobetsiB@aforbes.com.na;SofikaE@aforbes.com.na[/TD]
[/TR]
[TR]
[TD="width: 78, bgcolor: transparent"]ADL[/TD]
[TD="width: 102, bgcolor: transparent"] [/TD]
[TD="bgcolor: transparent"]1[/TD]
[TD="width: 819, bgcolor: transparent"]MoloseB@aforbes.co.za[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]ADR[/TD]
[TD="bgcolor: transparent"] [/TD]
[TD="bgcolor: transparent"]3[/TD]
[TD="bgcolor: transparent"]FakudeN@aforbes.co.za;CoombeT@aforbes.co.za[/TD]
[/TR]
</tbody>[/TABLE]
I hope that somebody can help me if this is possible. I am new at this so please bear with me. I am sending emails with the code below and it works fine. What I would like to do is save those emails to my drive for record purposes. Is this possible
Thanks
Preston
Dim OutApp As Object
Dim OutMail As Object
Dim Dest As Variant
Dim SDest As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' email address in worksheet
Dest = cell.Offset(0, 1).Value
With OutMail
.To = Dest
.CC = ""
.BCC = ""
.Subject = Filename
.Body = "Good Day" & vbNewLine & vbNewLine & "Please find attached your monthly shedules."
.Attachments.Add ActiveWorkbook.FullName
'.Attachments.Add (Path & sfile)
.Send 'or use
'.Display
.OriginatorDeliveryReportRequested = True
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
[TABLE="width: 827"]
<colgroup><col width="78" style="width: 59pt; mso-width-source: userset; mso-width-alt: 2852;"><colgroup><col width="102" style="width: 77pt; mso-width-source: userset; mso-width-alt: 3730;"><colgroup><col width="102" style="width: 77pt; mso-width-source: userset; mso-width-alt: 3730;"><colgroup><col width="819" style="width: 614pt; mso-width-source: userset; mso-width-alt: 29952;"><tbody>[TR]
[TD="width: 78, bgcolor: #0070C0"]INST
[/TD]
[TD="width: 102, bgcolor: #0070C0"]DED TYPE[/TD]
[TD="width: 102, bgcolor: #0070C0"]COUNT[/TD]
[TD="width: 819, bgcolor: transparent, align: left"]
<tbody>
[TD="width: 819, bgcolor: #0070C0"] CONTACTS [/TD]
</tbody>
[/TR]
[TR]
[TD="bgcolor: transparent"]ABH[/TD]
[TD="bgcolor: transparent"] [/TD]
[TD="bgcolor: transparent"]7[/TD]
[TD="bgcolor: transparent"]Ebfundservices@metropolitan.co.za [/TD]
[/TR]
[TR]
[TD="width: 78, bgcolor: transparent"]ADD[/TD]
[TD="width: 102, bgcolor: transparent"] [/TD]
[TD="width: 102, bgcolor: transparent"]1[/TD]
[TD="width: 819, bgcolor: transparent"]AFRFContributions@aforbes.co.za;KgobetsiB@aforbes.com.na;SofikaE@aforbes.com.na[/TD]
[/TR]
[TR]
[TD="width: 78, bgcolor: transparent"]ADL[/TD]
[TD="width: 102, bgcolor: transparent"] [/TD]
[TD="bgcolor: transparent"]1[/TD]
[TD="width: 819, bgcolor: transparent"]MoloseB@aforbes.co.za[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]ADR[/TD]
[TD="bgcolor: transparent"] [/TD]
[TD="bgcolor: transparent"]3[/TD]
[TD="bgcolor: transparent"]FakudeN@aforbes.co.za;CoombeT@aforbes.co.za[/TD]
[/TR]
</tbody>[/TABLE]