Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Email with attachment from range
Hello all,
I have this two VB code that I need to combin, could someone help me out? Thanks From: Ron de Bruin ( Last update 28 Oct 2006 ) Sub Send_Files() 'Working in 2000-2007 Dim OutApp As Object Dim OutMail As Object Dim sh As Worksheet Dim cell As Range, FileCell As Range, rng As Range With Application .EnableEvents = False .ScreenUpdating = False End With Set sh = Sheets("Sheet1") Set OutApp = CreateObject("Outlook.Application") OutApp.Session.Logon For Each cell In sh.Columns("B").Cells.SpecialCells(xlCellTypeConst ants) 'Enter the file names in the C:Z column in each row Set rng = sh.Cells(cell.Row, 1).Range("C1:Z1") If cell.Value Like "?*@?*.?*" And _ Application.WorksheetFunction.CountA(rng) 0 Then Set OutMail = OutApp.CreateItem(0) With OutMail .To = cell.Value .Subject = "Testfile" .Body = "Hi " & cell.Offset(0, -1).Value For Each FileCell In rng.SpecialCells(xlCellTypeConstants) If Trim(FileCell) < "" Then If Dir(FileCell.Value) < "" Then .Attachments.Add FileCell.Value End If End If Next FileCell .Send 'Or use Display End With Set OutMail = Nothing End If Next cell Set OutApp = Nothing With Application .EnableEvents = True .ScreenUpdating = True End With End Sub From: Dennis Wallentin Created on 2005-12-28 Sub Send_Active_Sheet() Dim stFileName As String Dim vaRecipients As Variant Dim noSession As Object Dim noDatabase As Object Dim noDocument As Object Dim noEmbedObject As Object Dim noAttachment As Object Dim stAttachment As String 'Copy the active sheet to a new temporarily workbook. With ActiveSheet .Copy stFileName = .Range("A1").Value End With stAttachment = stPath & "\" & stFileName & ".xls" 'Save and close the temporarily workbook. With ActiveWorkbook .SaveAs stAttachment .Close End With 'Create the list of recipients. vaRecipients = ", ") 'Instantiate the Lotus Notes COM's Objects. Set noSession = CreateObject("Notes.NotesSession") Set noDatabase = noSession.GETDATABASE("", "") 'If Lotus Notes is not open then open the mail-part of it. If noDatabase.IsOpen = False Then noDatabase.OPENMAIL 'Create the e-mail and the attachment. Set noDocument = noDatabase.CreateDocument Set noAttachment = noDocument.CreateRichTextItem("stAttachment") Set noEmbedObject = noAttachment.EmbedObject(EMBED_ATTACHMENT, "", stAttachment) 'Add values to the created e-mail main properties. With noDocument .Form = "Memo" .SendTo = vaRecipients .CopyTo = vaCopyTo .Subject = stSubject .Body = vaMsg .SaveMessageOnSend = True .PostedDate = Now() .Send 0, vaRecipients End With 'Delete the temporarily workbook. Kill stAttachment 'Release objects from memory. Set noEmbedObject = Nothing Set noAttachment = Nothing Set noDocument = Nothing Set noDatabase = Nothing Set noSession = Nothing MsgBox "The e-mail has successfully been created and distributed", vbInformation End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Excel VBA macro to send email attachment from default email client | Excel Programming | |||
Sending a Spreadsheet as an Email Attachment vs. Imbedded in Email | Excel Discussion (Misc queries) | |||
Email Attachment | Excel Discussion (Misc queries) | |||
send wkbk as an email attachment with an email address copied from | Excel Discussion (Misc queries) | |||
email attachment | New Users to Excel |