Here's the code I use in XL 2003 with Outlook 2003. This is a "one button"
solution for me . . . it creates a subject, body text, email addresses,
etc., from information in the workbook. I usually display the email and
then send to avoid the security warnings and to provide an opportunity to
add any changes to the body text. 99% of the time, I can just click send
and be done.
Sub btnEmail_Click()
' btnEmailReport_Click 12/13/2004 by Rick Teale
' Saves a copy of the CapJob-Master.xls and renames it to the Plant & Job
Title
' New workbook is attached to an email and sent to Plant Manager.
' You must add a reference to the Microsoft Outlook 11.0 Object Library
'
Dim OutApp As Outlook.Application
Dim OutMail As Outlook.MailItem
Dim wb As Workbook
Dim txtSubject As String
Dim txtJobNumber As String
Dim txtPlant As String
Dim txtPltJobNumber As String
Dim txtJobTitle As String
Dim txtSupr As String
Dim txtPlantName As String
Dim txtBodyText As String
Application.ScreenUpdating = False
txtJobTitle = Range("JobTitle").Value
txtJobNumber = Range("JobNumber").Value
txtPlant = Left(Range("JobNumber"), 3)
txtPltJobNumber = Right(Range("JobNumber"), 3) & " "
If txtPlant = "100" Then
txtPlantName = "Plant 100 "
txtSupr = "Supr100@..."
Else: txtPlantName = "200 ": txtSupr = "Supr200@..."
End If
' Set up file name variable based on Plant Job Vs. Capital Job . . .
If Range("PltJob").Value = "" Then
txtJobFileName = txtPlant & "-" & txtJobTitle & ".xls"
txtBodyText = "George, " & vbCrLf & vbCrLf & "Attached for
routing approval is " & txtPlantName & "Capital Job " & Chr(34) &
txtJobTitle & Chr(34) & "." & vbCrLf & vbCrLf & "Rick"
txtSubject = txtPlant & " Capital Job for Routing"
Else: txtJobFileName = txtPlant & "-" & txtPltJobNumber & txtJobTitle &
".xls"
txtBodyText = "George, " & vbCrLf & vbCrLf & "Attached for
routing approval is " & txtPlantName & "Plant Job " & Chr(34) & txtJobTitle
& Chr(34) & "." & vbCrLf & vbCrLf & "Rick"
txtSubject = txtPlant & " Plant Job for Routing"
End If
Set wb = ActiveWorkbook
With wb
.UpdateLinks = xlUpdateLinksNever
.SaveAs "C:\CAP JOBS\2004\" & txtPlant & "\" & txtJobFileName
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
With OutMail
.To = "George@..."
.CC = txtSupr
.BCC = "rteale@..."
.Subject = txtSubject
.Body = txtBodyText
.Attachments.Add wb.FullName
'.Send 'or use .Display
.Display 'for debug
End With
End With
Application.ScreenUpdating = True
Set OutMail = Nothing
Set OutApp = Nothing
End Sub