Strange attachment on automated email

[stevewood1]

Hello,

I have a macro that automatically sends an email with a copy of the workbook as an attachment. I recently made a slight change to add an extra cell value on to the name of the attachment and since then a number of users when they send the email have additional system file attachments on their emails and not just the workbook.

My code is below. The only line that I changed is the one highlighed below in red and it used to just say TempFileName = "EDC" and I never previously had this issue.


I can't attach a picture showing the additional attachment but it shows as a series of letters and numbers and may be a link or screenshot of the users temporary files. It has the file type of FILE according to it's properties.

Any help would be gratefully appreciated



Sub Bevel1_Click()

Dim sh As Worksheet
Dim OutlookApp As Object
Dim OutlookMail As Object
Dim signature As String
#If Win64 Then
Set OutlookApp = GetObject(, "Outlook.Application")
#Else
Set OutlookApp = CreateObject("Outlook.Application")
#End If
Set OutlookMail = OutlookApp.CreateItem(0)
Dim yourPassword As String
Dim EDC As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim FileFormatNum As Long


yourPassword = "Haribo12"

For Each sh In ActiveWorkbook.Worksheets
sh.Unprotect Password:=yourPassword

Next sh

Set EDC = ThisWorkbook
TempFilePath = Environ$("temp") & ""
TempFileName = "EDC" & " " & Sheets("Welcome").Range("Q15").Value
FileExtStr = ".xlsm": FileFormatNum = 52

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

On Error Resume Next
With OutlookMail
.Display
End With
signature = OutlookMail.Body
With OutlookMail
.To = Sheets("Welcome").Range("R3").Value
.CC = ""
.BCC = ""
.Subject = Sheets("Welcome").Range("R6").Value
.HTMLBody = "<p style='font-family:calibri;font-size:14'>" & "Please find the attached checking template." & "</p>" & vbNewLine & signature
.Attachments.Add EDC.FullName
.Send
End With


End With
Kill TempFilePath & TempFileName & FileExtStr
Set OutlookMail = Nothing
Set OutlookApp = Nothing


For Each sh In ActiveWorkbook.Worksheets
sh.Protect Password:=yourPassword
Next sh

Kill TempFilePath & TempFileName & FileExtStr



End Sub

 

[sijpie]

Hi stevewood1, can you make sure that next time you enclose your code in code tags (see example in blue/red below). That will make your code easier to read, and will attract more people to reply.

it sounds weird indeed. It is not that the code loops to add a number of files.
Have you checked the EDC.FullPath at the moment of attachment (use debug.print or a msgbox)?
Have you checked when you store the temporary copy to a different directory?
Is there a difference when the temp directory contains only one EDCxxx.xlsm or more?

furthermore you can clean up your code:
The 'End With' line belonging to the 'With EDC' could be moved to just before 'On Error resume Next'
The 'On Error resume Next' is not reset with a 'On Error Goto 0' (Is the on error resume next really required?)
You refer to the full path either as EDC.Fullname or as 'TempFilePath & TempFileName & FileExtStr'
You are trying to delete the temporary file twice. the second time after you have protected each sheet. (Should the sheets not be protected before you send?)

hope this will help