Help with VBA - Putting a section of txt from excel into an email

[peter_z]

Hey Guys,

I currently have a spreadsheet which is being accessed by multiple users. A copy of the spread sheet is being saved and then sent as an attachment in outlook when you push a send email button. After this the copy is deleted.

There is a drop down box in excel that has "Cancelled" or "30 Days".

Any ideas how to select only a few fields when the user selected Cancelled and put it into the body of the email?

Sub SendEmails()
Dim aOutlook As Object
Dim aEmail As Object, x As Long
Dim rngeAddresses As Range, rngeCell As Range, strRecipients As String
Dim lngCount As Long
Dim strdate As Date, strTitle As String, strSource As String, StrOutput As String
Dim strImage As String, strImage2 As String
Dim colAttach As Object
Dim oAttach As Object
 
'Set Variables
strUNC = "File Path"
strSource = "Reference"
strTitle = "TitleRef"
'Set File Name
StrOutput = "NAME of File.xls"
 
StrOutput = strUNC & StrOutput
'Set the date for the email title
strdate = Worksheets(strTitle).Range("J8").Value
'Build recipients list
'With Worksheets(StrSource)
'    lngCount = .Range("S1").Value
'    'Debug.Print "lngCount = " & lngCount
'        For x = 1 To lngCount
'            'Debug.Print "x = " & x
'            If x = lngCount Then
'                strRecipients = strRecipients & .Range("P" & x + 1).Value
'            Else
'                strRecipients = strRecipients & .Range("P" & x + 1).Value & "; "
'            End If
'         Debug.Print "strRecipients = " & strRecipients
'         Next x
'End With
'set outlook
Set aOutlook = CreateObject("Outlook.Application")
Set aEmail = aOutlook.CreateItem(0)
'Set colAttach = CreateObject("Outlook.Attachments")
'Set oAttach = CreateObject("Outlook.Attachments")
 
'set Importance
aEmail.Importance = 2
'Set Subject
aEmail.Subject = "Bordereau " & strdate
'Set Body for mail
aEmail.body = " BODY OF EMAIL" 'Change Body Message
size=2>" & _
    "[IMG]http://www.mrexcel.com/forum/<font color=red>cid: & strImage2 & </font>[/IMG] "
    'aEmail.Save
    'aEmail.Display 'fill in the To, Subject, and Send. Or program it in.
'Set attachment
aEmail.Attachments.Add StrOutput
'Set Recipient
'aEmail.To = strRecipients
'Send Mail
aEmail.Display
'Pop up msg box advising who the email has been sent to
'MsgBox ("Email Sent to: " & strRecipients)
 
End Sub
 
Sub SaveWorksheetAsWorkbook()
'Working in 97-2010
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim Destwb As Workbook
    Dim sourcewb As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim strWorksheet As String
    Dim StrWorksheet2 As String
    Dim strSource As String
    Dim i As Long
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .DisplayAlerts = False
    End With
    strWorksheet = "OUTPUT"
    StrWorksheet2 = "ANALYSIS"
    strSource = "Reference"
 
    'Determine the Excel version and file extension/format
    FileFormatNum = 56
    'Save the new workbook/Mail it/Delete it
 
    'Set the folder it will save into
    TempFilePath = "link to filepath"    
    'Set the name of the file
    TempFileName = "Name of file.xls"          
    Set sourcewb = ActiveWorkbook
 
        'Copy the sheet to a new workbook
    sourcewb.Sheets(Array("STATEMENT", "REPORT")).Copy
 
    Set Destwb = ActiveWorkbook
    With Destwb
 
        .SaveAs TempFilePath & TempFileName & FileExtStr, _
                FileFormat:=FileFormatNum
        Workbooks(TempFileName & FileExtStr).Close True
 
    End With
Application.DisplayAlerts = False
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub