Emai sheets

Zibi

Board Regular
Joined
Feb 2, 2012
Messages
70
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
 

Some videos you may like

Excel Facts

Excel motto
Not everything I do at work revolves around Excel. Only the fun parts.

ranman256

Well-known Member
Joined
Jun 17, 2014
Messages
1,902
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

Board Regular
Joined
Feb 2, 2012
Messages
70
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

Well-known Member
Joined
Jun 17, 2014
Messages
1,902
You figure out what to put for SUBJECT and BODY.

Code:
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

Board Regular
Joined
Feb 2, 2012
Messages
70
hi,

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

Watch MrExcel Video

Forum statistics

Threads
1,109,538
Messages
5,529,430
Members
409,876
Latest member
Akash Yadav
Top