Maxcro to Attsch File

[howard]

I have the month and year ain Cell D1 on sheet "Email" in format mmm-yyyy


I have code below to create and email in Outlook and to save the file name to be attached as Reports Outstanding +the Month and year in Cell D1.xlsx

I get a run time error and yhe code below is highlighted

 .Attachments.Add Environ("TMP") & "t" & ThisWorkbook.Sheets("Reports Outstanding").Name & " " & Format(ThisWorkbook.Sheets("Email").Range("D1").Value, "MMM-yyyy") & ".xlsx"

It would be appreciated if someone could amend my code

Sub emailOneItem()
Dim Ztext1 As String
Dim Zsubject1 As String


Sheets("Reports Outstanding").Activate
'ThisWorkbook.Activate                           'start in THIS workbook
Ztext1 = [bodytext1]                              'read in text from named cell
Zsubject1 = [subjectText1]
     Sheets("Reports Outstanding").Copy
    With ActiveWorkbook
        '.Windows(1).Visible = False
        Application.DisplayAlerts = False

.SaveAs Environ("TMP") & "\" & "Reports Outstanding" & Format(ThisWorkbook.Sheets("Email").Range("D1").Value, "mmm-yyyy") & ".xlsx"

        Application.DisplayAlerts = True
        .Close (True)
    End With
    
    With CreateObject("Outlook.Application").CreateItem(0)
        .To = Join(Application.Transpose(Sheets("Reports Outstanding").Range("D2:D20").Value), ";")
        .Subject = Zsubject1
        .Body = Ztext1
        
      
 .Attachments.Add Environ("TMP") & "\" & ThisWorkbook.Sheets("Reports Outstanding").Name & " " & Format(ThisWorkbook.Sheets("Email").Range("D1").Value, "MMM-yyyy") & ".xlsx"



        .Display
        '.send
    End With
End Sub

 

[howard]

I have managed to amend the code and it works perfectly

 Sub emailOneItem()

Dim Ztext1 As String

Dim Zsubject1 As String



Ztext1 = [bodytext1] 'read in text from named cell

Zsubject1 = [subjectText1]



'Save Reports Outstanding sheet to a new workbook

Sheets("Reports Outstanding").Copy

With ActiveWorkbook

'.Windows(1).Visible = False

Application.DisplayAlerts = False

.SaveAs Environ("TMP") & "\" & "Reports Outstanding " & Format(ThisWorkbook.Sheets("Email").Range("D1").Value, "MMM-yyyy") & ".xlsx"

Application.DisplayAlerts = True

.Close (True)

End With



'Create and send email with attachment

With CreateObject("Outlook.Application").CreateItem(0)

.To = Join(Application.Transpose(Sheets("Reports Outstanding").Range("D2:D20").Value), ";")

.Subject = Zsubject1

.Body = Ztext1

.Attachments.Add Environ("TMP") & "\" & "Reports Outstanding " & Format(ThisWorkbook.Sheets("Email").Range("D1").Value, "MMM-yyyy") & ".xlsx"

.Display

'.send

End With

End Sub