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