Have a Question?

If you have any question you can ask below or enter what you are looking for!



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

    mitem.Send

Else

MsgBox "Please Input Right Email ID"

Range("Email").Activate

Exit Sub

End If

outLookApp.Quit

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