Emai sheets

[Zibi]

Hi,

can someone help me with code, I need to email using outlook 2010 sheet1 and sheet2 to email addresses located on sheet3 in column D, also the information on the sheets needs to be cleand (without formulas)


Please help

 

[ranman256]

Is it a list of emails in Col. D?
are the 2 sheets to go to everyone in a single email, or 1 mail for each person in the list?
can it just email the workbook? (easier)
what is the average airspeed of an unladen swallow?

 

[Zibi]

Yes the email addresses are in col D on sheet3, and since the workbook has number of other sheets it would be good if only the sheets 1 and 2 are sent.

Answer is 24 miles per hour

 

[ranman256]

You figure out what to put for SUBJECT and BODY.

Public Sub SendEmails()
Dim sBody
Dim vTo, vSubj
Dim vFile, vDir
vDir = Environ("UserProfile") & "\My Documents\"
vFile = vDir & "output.xls"
'================
    'send 1 email with everyones address, or
'================
Sheets(3).Activate
Range("D1").Select
While ActiveCell.Value <> ""
   vTo = vTo & ActiveCell.Value & ";"
   ActiveCell.Offset(1, 0).Select      'next row
Wend
  
  'copy the sheets to new workbook
Sheets(Array("Sheet1", "Sheet2")).Select
Sheets("Sheet2").Activate
Sheets(Array("Sheet1", "Sheet2")).Copy
ActiveWorkbook.SaveAs vFile, , , , , , , xlLocalSessionChanges
ActiveWorkbook.Close
  
vSubj = "Subject: workbook"
sBody = ""
Send1Email vTo, vSubj, sBody, vFile
End Sub
'-------
'YOU MUST ADD THE OUTLOOK APP IN REFERENCES!!!   checkmark OUTLOOK OBJECT LIB in the vbE menu, Tools, References
'-------
Public Function Send1Email(ByVal pvTo, ByVal pvSubj, ByVal pvBody, Optional pvFile) As Boolean
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem
On Error GoTo ErrMail
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(olMailItem)
With oMail
    .To = pvTo
    .Subject = pvSubj
    .Body = pvBody
    .Attachments.Add pvFile, olByValue, 1
    
   .Send
End With

EmailO = True
Endit:
Set oMail = Nothing
Set oApp = Nothing
Exit Function
ErrMail:
MsgBox Err.Description, vbCritical, Err
Resume Endit
Resume
End Function

 

[Zibi]

hi,

For some reason my computer is crashing when it gets to<o></o>
ActiveWorkbook.SaveAs vFile, , , , , , , xlLocalSessionChanges