Outlook connectivity through Excel

How can we attach our document in outlook and change the subject line. The most important thing is that i want to send our email from excel using VBA macro.

  Devbrat Tripathi

Hi Devbrat

You can use below code to perform this task and i have also created a tool which will help you to perform your task.

You can access the file from here Excel Outlook

Public Sentmag As String

Sub SenDmail()

Dim outLookApp As Object

Set outLookApp = CreateObject("Outlook.application")

Dim FileName As String

Dim data As Integer

Dim Msg As String

Dim mitem As Object

Dim Sign As String

Dim Attachments As Integer

Dim att As Integer

Attachmensts = WorksheetFunction.CountA(Range("Attachments"))

Dim recp As String

Dim SentData As Integer

Dim msgConut As Integer

Msgcount = WorksheetFunction.CountA(Range("Mass"))

Dim msglp As Integer

For msglp = 1 To Msgcount

Msg = Msg & vbCrLf & Range("Mass").Cells(msglp, 1).Value

Next msglp

Sentmag = Msg

Dim Sig As Integer

Sig = WorksheetFunction.CountA(Range("Signature"))

Dim sigLp As Integer

For sigLp = 1 To Sig

Sign = Sign & vbCrLf & Range("SIgnature").Cells(sigLp, 1).Value

Next sigLp

Msg = Msg & vbCrLf & Sign

data = WorksheetFunction.CountA(Range("A:A"))

Dim i As Integer

FileName = ""

If Range("Email").Value Like "*@*" Then

Set mitem = outLookApp.CreateItem(olMailItem)

    With mitem

    .To = Range("Email")

    .Subject = Range("Subject")

    .Body = Msg

    For att = 1 To Attachmensts

    If Attachmensts = 0 Then

    .Attachments.Add Nothing

    Exit For

    End If

    FileName = Range("Attachments").Cells(att, 1).Value

    .Attachments.Add FileName

    Next att

    End With



MsgBox "Please Input Right Email ID"


Exit Sub

End If


Set outLookApp = Nothing

Call CreateSendData

MsgBox "Mail Has been Sent ", vbInformation

End Sub


Sub CreateSendData()

Range("A2").EntireRow.Insert Shift:=Down

'SentData = WorksheetFunction.CountA(Sheets("SentItems").Range("A:A")) + 1

Sheets("SentItems").Range("A2").Value = Range("Email")

Sheets("Sentitems").Range("B2").Value = Range("SUbject")

Sheets("Sentitems").Range("C2").Value = Date

Sheets("Sentitems").Range("D2").Value = Time

Sheets("Sentitems").Range("E2").Value = Sentmag

    End Sub


  pankaj       18 Mar 2017       0       0     

Post Your Answers:

Please use the CODE HIGHLIGHT Button to format/highlight your codes if any