Logo 
Search:

MS Office Answers

Ask Question   UnAnswered
Home » Forum » MS Office       RSS Feeds
  Question Asked By: Bonni Garcia   on Nov 01 In MS Office Category.

  
Question Answered By: Tate Thompson   on Nov 01

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

Share: 

 

This Question has 4 more answer(s). View Complete Question Thread

 
Didn't find what you were looking for? Find more on VB code to send Mail from Excel? Or get search suggestion and latest updates.


Tagged: