Email Macro
 

I am just trying to make a simple macro to send an excel (2003) workbook as
an attachement within Outlook. I recorded my macro as file-send as
attachment-entered the email addresses-send. That part all works well. When
I assign the macro to a click button it sends it correctly and the email is
received. My problem is that an Outlook email form keeps popping up again.
I just want it to send the form and then go back to Excel, maybe even add
something that shows the email was sent. Can anyone help. I have seen Ron's
site, but that is not working for me. I can't do his add-ins b/c I am not
the administrator of my computer.

Email Macro
 

G'day Cindy

I use Ron's code to e-mail most of my reports with CC & BCC including
signature, and message body.

Did you remember to change the 3 lines of code that differentiate between
Outlook Express & MS Outlook, just a thought!

The only annoying thing that pops up for me is, is when I have a Group list
I am sending to as the group is listed on the admin server and not in my
contact list, other than that everything works well.

Here is my code structure, check it against your's and see if it differs, if
so, change as required.

HTH
Mark.

Sub Mail_ActiveSheet()
'Working in 2000-2007
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

ActiveSheet.Copy
Set DestWB = ActiveWorkbook

With DestWB
If Val(Application.Version) < 12 Then

FileExtStr = ".xls": FileFormatNum = -4143
Else

If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
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 If
End With


' Application.CutCopyMode = False

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm")

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

With DestWB
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "Linehaul (List)"
.CC = "TB; GS; DM; RC"
.BCC = ""
.Subject = "Linehaul Report"
.Body = "Morning All"
.Display

End With
On Error GoTo 0
.Close SaveChanges:=False
End With

Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

With Application
CalcMode = .Calculation
.Calculation = xlAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With

End Sub