Good Morning,
I’m helping a co-worker modify some code she borrowed from the internet to create an e-mail from an Excel file. Everything works well with one exception. We want to be able to send the e-mail containing the excel file AND the file keep the macro so the file can be reused and sent again. As of now, it tried to use the macro from another existing copy on my desktop when I open it again from the e-mail.
Here is the existing code... cleaned up a little to not show the company sepcific links and modifications:
Sub Mail_ActiveSheet()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
Sheets("Sheet Info").Copy
Set Destwb = ActiveWorkbook
With Destwb
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With
TempFilePath = Environ$("temp") & ""
TempFileName = Sourcewb.Name & " " & Format(Now, "mm-dd-yy")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
' The E-Mail is generated using the following format and message
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = Range("H4")
.cc = ""
.BCC = ""
.Subject = "Subject Text"
.Body = "Body Text"
.Attachments.Add Destwb.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
End With
End Sub
I’m helping a co-worker modify some code she borrowed from the internet to create an e-mail from an Excel file. Everything works well with one exception. We want to be able to send the e-mail containing the excel file AND the file keep the macro so the file can be reused and sent again. As of now, it tried to use the macro from another existing copy on my desktop when I open it again from the e-mail.
Here is the existing code... cleaned up a little to not show the company sepcific links and modifications:
Sub Mail_ActiveSheet()
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set Sourcewb = ActiveWorkbook
Sheets("Sheet Info").Copy
Set Destwb = ActiveWorkbook
With Destwb
If Val(Application.Version) < 12 Then
FileExtStr = ".xls": FileFormatNum = -4143
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End With
TempFilePath = Environ$("temp") & ""
TempFileName = Sourcewb.Name & " " & Format(Now, "mm-dd-yy")
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
' The E-Mail is generated using the following format and message
With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.to = Range("H4")
.cc = ""
.BCC = ""
.Subject = "Subject Text"
.Body = "Body Text"
.Attachments.Add Destwb.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
End With
End Sub