how to send an email

[rakesh seebaruth]

hi there

i have a cell b2 for example . If cell b2=qb then email attachment to example@yahoo.com.

If cell b2=rs then email attachment to example1@yahoo.com

How to do this in vba please

regards

rakesh

 

[ranman256]

sub Test()
select case  range("B2").value 
   case "qb"
      email2 "example@yahoo.com", "subject", "body"
   case "rs"
      email2 "example1@yahoo.com", "subject", "body"
end select
end sub

'-------
'YOU MUST ADD THE OUTLOOK APP IN REFERENCES!!!   checkmark OUTLOOK in the vbE menu, Tools, References
'-------
Public Function Email2(ByVal pvTo, ByVal pvSubj, ByVal pvBody) 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 activeworkbook.FullName, olByValue, 1
    
.Send
End With
EmailO = True
Set oMail = Nothing
Set oApp = Nothing
Exit Function
ErrMail:
MsgBox Err.Description, vbCritical, Err
Resume Next
End Function

 

[rakesh seebaruth]

Thanks for you response. ok. i have the following vba codes :-

Sub Mail_ John1()

Range("b2") = Format(Date, "dd/mmmm/yyyy")

Const mydrive = "R:"

Const mydir = "Credit Admin\Seebaruth Rakesh\SEARCHES NO SIGNATURE"

Dim myname As String

Dim ss As String

myname = Sheets("sheet1").Range("e5").Text & Format(Date, "dd-mmm-yy") & ".xls"

ss = mydrive & "\" & mydir & "\" & myname & ".xls"

Application.DisplayAlerts = False

ActiveWorkbook.SaveCopyAs Filename:=ss

Application.DisplayAlerts = True

Dim i As Long, c As Range

For i = 1 To 2

Set c = Application.InputBox("Click in the cell to insert the Signature", Type:=8)

ActiveSheet.Pictures.Insert ("R:\Credit Admin\Seebaruth Rakesh\rakesh searches\sign.bmp")

With ActiveSheet.Shapes(ActiveSheet.Shapes.Count)

.LockAspectRatio = False

.Top = c.Top

.Left = c.Left

.Height = c.RowHeight

.Width = c.Width

End With

Next i

ActiveSheet.Protect "budget", True, True

Const mydrives = "R:"

Const mydirs = "Credit Admin\Seebaruth Rakesh\rakesh searches\2014"

Dim mynames As String

Dim ms As String

Dim OutApp As Object

Dim OutMail As Object

mynames = Sheets("sheet1").Range("e5").Text & Format(Date, "dd-mmm-yy") & ".xls"

ms = mydrives & "\" & mydirs & "\" & mynames & ".xls"

Application.DisplayAlerts = False

ActiveWorkbook.SaveCopyAs Filename:=ms

Application.DisplayAlerts = True

Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next

With OutMail

.To = "john@intnet.mu"

.CC = ""

.BCC = ""

.Subject = Range("e5")

.Attachments.Add ms

.Send

End With

On Error GoTo 0

Set OutMail = Nothing

Set OutApp = Nothing

ThisWorkbook.Saved = True

Application.Quit

End Sub

i have 12 Sub Mail from Sub Mail_ John1() to Sub Mail_ Peter12(). Each individuals have their respectives email addresses. i would like to club all these 12 sub mail(Sub Mail_ John1() to Sub Mail_ Peter12() ) into one single sub Mail. Let's assume that if cell E25=JOHN then email attachement to "john@intnet.mu" . If cell E25=PETER then email attachement to ''peter@intnet.mu'' and so on with the rest. Can you please amend my above vba codes with highlighted in bold. Your help would be much appreciated.

Regards

rakesh

 

[rakesh seebaruth]

.