Macro to send file. How do I add hardcoding file and attachment?

[pjbltd]

Hi forum,

I have the macro below which works very well.
It creates an email from an excel sheet.
I now want to add into the macro some code to hard code that sheet (pnl.xlsx) and attach it to the email.

Any advice is much appreciated!!
Thank you,
pjbltd


Sub PnLEmail()
Sheets("P&L").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs ThisWorkbook.Path + "\PnL.xlsx"
ActiveWorkbook.Close
Application.DisplayAlerts = True
NewEmail [B46], "", [B47], SheetToHTML(Sheets("P&L")), ThisWorkbook.Path + "\PnL.xlsx"
End Sub
Private Sub NewEmail(ToField, CCField, SubjectLine, Body, Optional ByVal Attachment As String)
Application.ScreenUpdating = False
Dim olApp As Outlook.Application
Dim olMail As MailItem
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = ToField
.CC = CCField
.Subject = SubjectLine
.HTMLBody = Body
.Display
End With
Set olApp = Nothing
Set olMail = Nothing
End Sub
Private Function SheetToHTML(sheet As Worksheet) As String

Dim TempFile As String
Dim fso, ts As Object

sheet.Copy

TempFilePrefix = sheet.Parent.Path & "\TempSheet"
TempFile = TempFilePrefix & ".html"
TempFileFiles = TempFilePrefix & "_files"

Application.DisplayAlerts = False
With ActiveWorkbook.PublishObjects.Add(xlSourceSheet, TempFile, ActiveSheet.Name, "", xlHtmlStatic, "", "")
.Publish (True)
.AutoRepublish = False
End With
ActiveWorkbook.Close False
Application.DisplayAlerts = True

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
SheetToHTML = Replace(ts.ReadAll, "align=center", "align=left")
ts.Close
Set ts = Nothing

If fso.Fileexists(TempFile) Then
Kill TempFile
End If
If fso.Fileexists(TempFileFiles & "\filelist.xml") Then
Kill TempFileFiles & "\*.*"
RmDir TempFileFiles
End If

Set fso = Nothing
End Function

 

[John_w]

' Untested, but try adding:

.Attachments.Add 

' after:

.HTMLBody = Body

' And change:

NewEmail [B46], "", [B47], SheetToHTML(Sheets("P&L")), ThisWorkbook.Path + "\PnL.xlsx"

' to:

NewEmail [B46], "", [B47], "PnL.xlsx is attached.", ThisWorkbook.Path + "\PnL.xlsx"

 

[pjbltd]

Thanks John_w tried that but getting a compile error on the .Attachments.Add

"Argument not optional"

Any ideas?

Thanks,
pjbltd

 

[pjbltd]

Solved it with:

Private Sub NewEmail(ToField, CCField, SubjectLine, Body, Optional ByVal Attachment As String)
Application.ScreenUpdating = False
Dim olApp As Outlook.Application
Dim olMail As MailItem
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = ToField
.CC = CCField
.Subject = SubjectLine
.HTMLBody = Body
.Display
.Attachments.Add ThisWorkbook.Path + "\PnL .xlsx", olByValue, , _
"Attachment" ' insert attachment
End With
Set olApp = Nothing
Set olMail = Nothing
End Sub


Thanks!